使用源格式复制 Excel 数据

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

<< --这将适用于您的代码。>>

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.Using 引用对象，而不是 ActiveSheet.

2.check 如果在上一个代码运行期间应用了 AutoFilter。否则，如果在 sheet 的区域已被过滤时应用，它将从您的区域中删除过滤器，并且在尝试使用时会出现错误行： 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 数据

Copy Excel Data With Source Formatting

excel

vba

excel-2013