多数のワークブックのシート3を1つの新しいワークブックに結合します

Question

私は77のワークブックを持っており、すべてのシート3を新しいワークブックの1つのシートに結合する必要があります。私はこれを何年もやっていない。私は本当に助けていただければ幸いです。私は他のウェブページからいくつかのコードを修正しましたが、それは私のために働いていません。

は、Mをありがとう

ここ

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

それらのすべてが1つのフォルダにある場合、これは動作します：

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