使用源格式复制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"

来源

2016-11-17 StarsFlyFree FromCozyNights

您的循环什么都不做......它的目的是什么？ – Rdster

我想复制一次过滤后显示的范围。 –

我明白，但你的For循环什么都不做，如果你需要找到LastRow只是使用'LastRow = Worksheets（“Sheet2”）。Range（“A65536”）。End（xlUp）.Row' – Rdster

不需要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

来源

2016-11-17 13:40:42 teddy2

我该如何将它粘贴到新表中？我试图做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

来源

2016-11-17 14:07:53

使用源格式复制Excel数据

回答

相关问题