Question

我录制了一个宏来执行此操作，并复制宏代码并根据我的需要进行调整。但是，我的问题是，当我粘贴到新工作表时，不保留源格式。我错过了什么步骤？它必须与Selection.PasteSpecial权利有关？以下是非工作语法

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"

Answer 1

不需要Selection.PasteSpecial，正常Copy方法就足够了。

Sub copyTest()

    '/ Source             Destination
    '--------             -----------
    Sheet1.UsedRange.Copy Sheet2.Cells(1, 1)
    Application.CutCopyMode = False

End Sub

＆LT;＆LT; - 这适用于您的代码。＆gt;＆gt;

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

Answer 2

尝试以下代码：

1.使用引用的对象，而不是ActiveSheet。

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

使用源格式复制Excel数据

2 个答案: