將文件夾中多個工作簿中的數據複製到一個工作簿中僅粘貼特殊值

Question

我想將一個文件夾中的多個工作簿的所有工作表複製到另一個工作簿中。我發現下面的代碼，但不知道如何粘貼特殊值，以避免不必要的格式。

Sub GetSheets() 

Path = "C:\Users\mechee69\Download\" 
Filename = Dir(Path & "*.xls") 
Do While Filename <> "" 
    Workbooks.Open Filename:=Path & Filename, ReadOnly:=True 
    For Each Sheet In ActiveWorkbook.Sheets  
     Sheet.Copy After:=ThisWorkbook.Sheets(1)  
    Next Sheet 
    Workbooks(Filename).Close 
    Filename = Dir() 
Loop 

End Sub 

Answer 1

嘗試下面的代碼，它將PasteSpecial只有Values，如果你願意，你可以擴展到也Formats複製。

Option Explicit 

Sub GetSheets() 

Dim Path As String, Filename As String 
Dim WB As Workbook 
Dim Sht As Worksheet, ShtDest As Worksheet 

Path = "C:\Users\mechee69\Download\" 
Filename = Dir(Path & "*.xls*") 

Application.ScreenUpdating = False 
Application.DisplayAlerts = False 

Do While Filename <> "" 
    Set WB = Workbooks.Open(Filename:=Path & Filename, ReadOnly:=True) 
    For Each Sht In WB.Sheets 
     Set ShtDest = ThisWorkbook.Sheets.Add(After:=Sheets(1)) 
     Sht.Cells.Copy 
     ShtDest.Name = Sht.Name '<-- might raise an error in case there are 2 sheets with the same name 
     ShtDest.Cells.PasteSpecial xlValues 
    Next Sht 
    WB.Close 
    Filename = Dir() 
Loop 

Application.ScreenUpdating = True 
Application.DisplayAlerts = True 

End Sub