使用源格式复制Excel数据
我录制了一个宏来完成这个工作,并复制了宏代码并将其调整为我所需要的。但是,我的问题是,当我粘贴到新工作表时,源格式不会保留。我错过了什么步骤?这一定与Selection.PasteSpecial
有关吗?下面是不工作的语法使用源格式复制Excel数据
Selection.AutoFilter
ActiveSheet.ListObjects("db1.accdb").Range.AutoFilter Field:=1, Criteria1:="Pink"
For LastRow = 2 To Worksheets("Sheet2").Range("A65536").End(xlUp).Row
Next LastRow
Range("A1", "M" & LastRow).Copy
Sheets.Add After:=ActiveSheet
Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Range("A1").Select
ActiveSheet.Name = "Pink"
不需要Selection.PasteSpecial
,正常Copy
方法就足够了。
Sub copyTest()
'/ Source Destination
'-------- -----------
Sheet1.UsedRange.Copy Sheet2.Cells(1, 1)
Application.CutCopyMode = False
End Sub
< < - 这会为你的代码工作>>
Sub Test()
Dim LastRow As Long
Dim rngCopy As Range
Selection.AutoFilter
ActiveSheet.ListObjects("db1.accdb").AutoFilter Field:=1, Criteria1:="Pink"
Set rngCopy = ActiveSheet.UsedRange
'/ Get rid of headers
Set rngCopy = rngCopy.Offset(1).Resize(rngCopy.Rows.Count - 1)
Set rngCopy = rngCopy.SpecialCells(XlCellType.xlCellTypeVisible)
ThisWorkbook.Worksheets.Add after:=ActiveSheet
ActiveSheet.Name = "Pink"
rngCopy.Copy ThisWorkbook.Worksheets("Pink").Cells(1, 1)
Application.CutCopyMode = False
End Sub
我该如何将它粘贴到新表中?我试图做Sheets.Add After:= ActiveSheet和目标Pink.Cells(1,1),但是抛出errro –
请参阅编辑。我不写定制的代码/答案,但今天我心情很好。 :) – teddy2
试试下面的代码:代替ActiveSheet
1.使用引用的对象。
2.检查是否在上次代码运行期间应用了AutoFilter
。否则,如果应用在薄板的区域已经过滤它将从您的区域删除的过滤器,你会得到一个错误行时尝试使用: Sht.ListObjects("db1.accdb").Range.AutoFilter Field:=1, Criteria1:="Pink"
全码:
Option Explicit
Sub CopyFilteredObject()
Dim LastRow As Long
Dim Sht As Worksheet
Dim DestSht As Worksheet
' better avoiding ActiveSheet >> use your sheet's name
Set Sht = ActiveSheet ' use Sheets("Sheet1") for example
' check if auto-filer is applied, if yes don't remove it by using AutoFilter again
If Sht.AutoFilter.FilterMode = False Then
Selection.AutoFilter
End If
Sht.ListObjects("db1.accdb").Range.AutoFilter Field:=1, Criteria1:="Pink"
' find last row
LastRow = Sht.Cells(Sht.Rows.Count, "A").End(xlUp).Row
' set destination sheet after current sheet
Set DestSht = Sheets.Add(after:=Sht)
DestSht.Name = "Pink"
Sht.Range("A1:M" & LastRow).Copy
DestSht.Cells.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
DestSht.Range("A1").Select
End Sub
您的循环什么都不做......它的目的是什么? – Rdster
我想复制一次过滤后显示的范围。 –
我明白,但你的For循环什么都不做,如果你需要找到LastRow只是使用'LastRow = Worksheets(“Sheet2”)。Range(“A65536”)。End(xlUp).Row' – Rdster