Zusammenführen von Arbeitsmappen nach Registerkartenname

Question

Ich hoffe, dass jemand helfen kann.

Ich suche mehrere Arbeitsmappen in Excel zusammen, aber jede Arbeitsmappe hat 8-10 Tabs, die ich nicht brauche und ich eigentlich nur eine einzige Registerkarte wollen, ich habe die folgende Formel bereits, die die Arbeitsmappen kombiniert, aber Ich bin mir nicht sicher, was ich tun soll, um nur die einzelnen Tabs zu kombinieren, die ich brauche. Sie sind in allen Arbeitsmappen identisch.

Sub GetSheets() 
Path = "C:\Users\dt\Desktop\dt kte\" 
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 

Danke

Answer 1

Wenn Sie nur ein bestimmtes Blatt von jedem kopiert werden müssen, (zwicken nur SHEETNAME, was auch immer das ist) die folgenden sollte funktionieren

Sub GetSheets() 
dim mainWB as Workbook 
Set mainWB = ThisWorkbook 
Path = "C:\Users\dt\Desktop\dt kte\" 
Filename = Dir(Path & "*.xls") 

    Do While Filename <> "" 
    Workbooks.Open Filename:=Path & Filename, ReadOnly:=True 
    For Each Sheet In ActiveWorkbook.Sheets 
    If sheet.Name = "SHEETNAME" then 
     Sheet.Copy After:=mainWB.Sheets(1) 
    End if 
    Next Sheet 
    Workbooks(Filename).Close 
    Filename = Dir() 
    Loop 
End Sub 

Answer 2

es ist einer jener Fälle, wo würde ich die berüchtigte Anweisung bewusst verwenden und vermeiden, durch eine Sammlung (nämlich Worksheets eins)

weiterhin ThisWorkbook verweist immer die Arbeitsmappe das Ausführen von Code in so liegt es gibt keine Notwendigkeit für jede Variable Workbook Typ verweis

Sub GetSheets()   
    Path = "C:\Users\dt\Desktop\dt kte\" 
    Filename = Dir(Path & "*.xls") 

    On Error Resume Next 
    Do While Filename <> "" 
     Workbooks.Open(Filename:=Path & Filename, ReadOnly:=True).Worksheets("SHEETNAME").Copy After:=ThisWorkbook.Sheets(1) 
     ActiveWorkbook.Close False 
     Filename = Dir() 
    Loop 
End Sub 

nur SHEETNAME Sie tatsächlich benötigte Registerkarte Name