将数据从文件夹中的多个工作簿复制到一个工作簿粘贴特殊值中

Question

我想将文件夹中多个工作簿的所有工作表复制到另一个工作簿中。我找到了下面的代码，但不知道如何粘贴特殊的仅值以避免不必要的格式。

Sub GetSheets()
Path = "C:Usersmechee69Download"
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:Usersmechee69Download"
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