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

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

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

Copy data from multiple workbooks in a folder into one workbook paste special only value

excel

vba

consolidation