Hallo miteinander, 

hier ein etwas anspruchsvolleres Projekt das mich seit einiger Zeit beschäftigt. Eines vorneweg: Ich bin absoluter VBA-Neuling und hangel mich seit mehreren Monaten durch die Thematik im Sinne von "Trial and Error". Für Vorschläge, den Code eleganter zu gestalten bin ich deshalb offen.

Ziel:

Es soll eine Gesamtübersicht in Excel erzeugt werden, in welche aus einem Online-Speicherort ca. 10 Tabellenblätter (Gruppen) hineinkopiert werden. Diese 10 Tabellenblätter besitzen jeweils ca. 10.000 Zeilen.

In der Gesamtübersicht sollen dann wiederum alle 10 Tabellenblätter zu einem Tabellenblatt zusammengefügt werden (Tabellenblätter_zusammenfassen).

Leider kopiert er mir nur die ersten Tabellenblätter mitsamt Leerzeilen. Ich möchte jedoch, dass Excel alle beschrifteten Zeilen von Tabellenblatt 1 bis Tabellenblatt 10 untereinander kopiert, ohne Leerzeilen und ohne die anderen zu überschreiben.

Vorab danke fürs Durchlesen!

'Gruppen von Speicherort in Tabellenblätter umwandeln

Sub Gruppen_zusammenführen()
   Dim oTargetBook As Object
   Dim oSourceBook As Object
   Dim sPfad As String
   Dim sDatei As String
     
     Application.ScreenUpdating = False 'Flackern ausstellen, falls notwendig
     Application.DisplayAlerts = False 'Keine Fehlermeldungen anzeigen
     
     'Arbeitsmappe festlegen, in die die neuen Sheets eingefügt werden...
     Set oTargetBook = ActiveWorkbook
    
     
     'Schleife über alle Excel Dateien in einem Verzeichnis/Ordner

     "\\C:Users\Admin\..."
     
     'Alle Excel-Dateien auswählen
     
     sDatei = Dir(CStr(sPfad & "*.xlsx*"))
     

     Do While sDatei <> ""
     
         'Öffnen der Datei und Datenübertragung alle Dateien in Gesamtübersicht
         Set oSourceBook = Workbooks.Open(sPfad & sDatei, False, True) 'nur lesend öffnen
         
        
         'Es wird immer das ZWEITE Tabellenblatt Sheets(2) kopiert!
         oSourceBook.Sheets(2).Copy after:=oTargetBook.Sheets(oTargetBook.Sheets.Count)
         
         
         'Dateiname der Tabelle wird Arbeitsblattname
         'Falls nicht lesbar, automatisch "Tabelle x" genannt
          On Error Resume Next
         
         'Arbeitsblattname wird der Dateiname
         oTargetBook.Sheets(oTargetBook.Sheets.Count).Name = sDatei
         
         
         'Wenn ein Fehler aufgetreten ist, wird dieser resettet
         If Err.Number <> 0 Then
             Err.Number = 0
             Err.Clear
         End If
         On Error GoTo 0
         
         'Datei wieder zu machen und nächste Schleifenrunde
         oSourceBook.Close False 'nicht speichern
         
         'Nächste Datei
         sDatei = Dir()
     Loop
     
     Application.ScreenUpdating = True 'Das Bildschirm-Aktualisieren wieder einschalten
     Application.DisplayAlerts = True 'Fehlermeldungen wieder anzeigen
     
    
     'Variablen aufräumen
     Set oTargetBook = Nothing
     Set oSourceBook = Nothing
End Sub



'Tabellenblätter als Werte kopieren

Sub Tabellenblätter_copy()
Dim i As Integer
For i = 2 To 9 'Anzahl Tabellenblätter in Gesamtübersicht
Worksheets(i).Copy after:=Sheets(9) 
ActiveSheet.UsedRange.Cells = ActiveSheet.UsedRange.Cells.Value
Next i

End Sub
Sub Tabellenblätter_zusammenfassen()

'Tabellenblatt 1 als "Zusammenfassung" deklarieren
Dim i As Integer
Dim Zusammenfassung As Worksheet

    'Ab dem zweiten Tabellenblatt zusammenfassen
    Set Zusammenfassung = Worksheets("Zusammenfassung")
    For i = 10 To 17

'Tabellenblätter untereinander einfügen

Set BereichZielTab = Worksheets(i).UsedRange
Set LetzteZeileZusammenfassung = Worksheets(1).Cells(Rows.Count, "A").End(xlUp)(2) 'wird in die ERSTE Zeile, Spalte A kopiert
BereichZielTab.Copy Destination:=LetzteZeileZusammenfassung
Next i

 'Finale Fertig-Meldung
     MsgBox "Fertig!", vbInformation + vbOKOnly, "Hinweis!"

End Sub

Grüße Manfred