Excel Tabellen zusammenführen

Sub Daten_aus_mehreren_Tabellen_einlesen()
Dim oTargetSheet As Object
Dim oSourceBook As Object
Dim sPfad As String
Dim sDatei As String
Dim lErgebnisZeile As Long
Dim s As Long
Dim z As Long
Application.ScreenUpdating = False 'Das "Flackern" ausstellen
'Schritt 1: Neues Arbeitsblatt für die Ergebnisse erstellen
Set oTargetSheet = ActiveWorkbook.Sheets.Add
lErgebnisZeile = 1 'Ergebnisse eintragen ab Zeile 1
'Schritt 2: Schleife über alle Excel Dateien in einem Verzeichnis
sPfad = "C:\Users\Testuser\090_Daten\Basisdaten\"
sDatei = Dir(CStr(sPfad & "*.xl*")) 'Alle Excel Dateien
Do While sDatei  ""
'Schritt 3: öffnen der Datei und Datenübertragung
Set oSourceBook = Workbooks.Open(sPfad & sDatei, False, True) 'nur lesend öffnen
'Datenübertragung alle genutzten Zeilen und Spalten
For z = 1 To oSourceBook.Sheets("Tabelle1").UsedRange.Rows.Count
'Keine Leerzeilen verarbeiten
If Trim(CStr(oSourceBook.Sheets("Tabelle1").Cells(z, 1).Value))  "" Then
For s = 1 To oSourceBook.Sheets("Tabelle1").UsedRange.Columns.Count
'Spalte 2 bis n - Tabelleninhalte des Arbeitsblattes " _
Tabelle1"
oTargetSheet.Cells(lErgebnisZeile, s).Value = _
oSourceBook.Sheets("Tabelle1").Cells(z, s).Value
Next s
lErgebnisZeile = lErgebnisZeile + 1
End If
Next z
'Schritt 4: 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
'Variablen aufräumen
Set oTargetSheet = Nothing
Set oSourceBook = Nothing
'Die Spalten A-Z optimal ausrichten
With ActiveCell
Columns("A:Z").Select
Range(Selection, Selection.End(xlToRight)).Select
Cells.EntireColumn.AutoFit
'Sortiert die Produktbezeichnung Alphabetisch
Selection.Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlYes, key2:=Range("A2"),    _
_
_
_
Order2:=xlDescending, Header:=xlYes
'Befehl wo der Cursor stehen soll wenn Befehl beendet
Sheets("Tabelle1").Select
Range("A1").Select
End With
End Sub