将来自多个工作簿的工作表3合并到一个新工作簿中

Question

我有77个工作簿，需要将工作表3全部合并到新工作簿中的一个工作表中。我好几年没有这样做过。我会很感激任何帮助。我修改了其他网页的一些代码，但它不适合我。

谢谢，男

Answer 1

这里是我有，你能满足你的需要

Sub ConslidateWorkbooks() 
    'Code to pull sheets from multiple Excel files in one file directory 
    'into master "Consolidation" sheet. 

    Dim FolderPath As String 
    Dim Filename As String 
    Dim Sheet As Worksheet 

    Application.ScreenUpdating = False 
    FolderPath = "[REDACTED]" 
    Filename = Dir(FolderPath & "*.xlsx") 

    Do While Filename <> "" 
     Workbooks.Open Filename:=FolderPath & Filename, ReadOnly:=True 
     copyOrRefreshSheet ThisWorkbook, Sheets(3) 
     Workbooks(Filename).Close 
     Filename = Dir() 
    Loop 

    Application.ScreenUpdating = True 

End Sub 



Sub copyOrRefreshSheet(destWb As Workbook, sourceWs As Worksheet) 
    Dim ws As Worksheet 
    On Error Resume Next 
    Set ws = destWb.Worksheets(sourceWs.Name) 
    On Error GoTo 0 
    If ws Is Nothing Then 
     sourceWs.Copy After:=destWb.Worksheets(destWb.Worksheets.Count) 
    Else 
     ws.Cells.ClearContents 
     ws.Range(sourceWs.UsedRange.Address).Value = sourceWs.UsedRange.Value2 
    End If 
End Sub 

它可能无法正常工作完美，但它应该指向你在正确的道路上

Answer 2

如果他们都在一个文件夹中，那么这个工作：

Sub CopySheetsOver() 
Dim Path As String, Filename As String 
Dim wbk As Workbook 
Dim wsh As Worksheet 

Path = "C:\Users\MaryGM\Desktop\YourFolder\" 'set the path to the desired folder 
Filename = Dir(Path & "*.xls") 'get names of all xls files, change to xlsx if desired 

Do While Filename <> "" 'loop over all the xlsx files in that folder 
    Workbooks.Open Filename:=Path & Filename, ReadOnly:=True 

    Set wbk = ActiveWorkbook 
    If wbk.Worksheets.Count > 2 Then 'check if the third sheet exists 
    Set wsh = wbk.Sheets(3) 
    wsh.Copy After:=ThisWorkbook.Sheets(1) 
    'set the name to be combination of original sheet name and its corresponding workbook: 
    ThisWorkbook.ActiveSheet.Name = wbk.Name & "-" & wsh.Name 
    End If 
    Workbooks(Filename).Close 
    Filename = Dir() 
Loop 
End Sub