使用源格式複製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數據

回答

相關問題