0

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

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
4

1 回答 1

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
于 2017-03-18T18:21:19.887 回答