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

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

1 个答案: