將來自多個工作簿的工作表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