805 Aufrufe
Gefragt in Tabellenkalkulation von
Hallo!
Ich bin noch nicht ganz so fit in VBA. Jetzt erhoffe ich mir hier Hilfe bei meinen Problem.

Ich muss, jeweils die erste Tabelle einer jeden Exceldatei untereinander ohne Leerzeile in eine neue Datei übernehmen. Jede erste Tabelle/Register/Sheet hat den gleichen Aufbau.

Jede Quelldatei, enthält Daten von Spalte A bis AF und Zeile 1 bis untere Grenze, Dateien.
Ich bräuchte allerdings nur ab Zeile 11 bis letzte ausgefüllte Zeile und von Spalte A bis Spalte T die Daten.

Die Zusammenfügung der ersten Tabellen der Quelldateien sollen in der Zieldatei (übrigens auch in Tabelle1) ab Zeile 2 starten.

Ich hoffe ich habe mich verständlich genug ausgedrückt und mein Problem ausführlich genug geschildert.

Am nachfolgenden Code habe ich mal meine Vba-Künste freien Lauf gelassen. Leider ohne Erfolg, es tut sich nichts.
Das Grundgerüst habe ich im Internet gefunden und auf meine Bedürfnisse versucht umzuformulieren. Leider missglückte dieser Versuch.

Kann mir jemand helfen diesen Code zu "reparieren" oder wenn Vba-Koryphäen der Meinung sind, dass "mein" Code BullShit ist, bitte Vorschläge liefern wie man das besser gestalten kann.

Danke im Voraus!

Gruss Jean

*********************

Sub MWTabellenAusMehrerenDateienEinlesen()
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: geöffnetes Arbeitsblatt für die Ergebnisse verwenden
Set oTargetSheet = ActiveWorkbook
lErgebnisZeile = 2 'Ergebnisse eintragen ab Zeile 2

'Schritt 2: Schleife über alle Excel Dateien in einem Verzeichnis
sPfad = "C:\Users\XY\Desktop\AB"
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").Range.Rows.Count
'Keine Leerzeilen verarbeiten
If Trim(CStr(oSourceBook.Sheets("Tabelle1").Cells(z, 1).Value)) <> "" Then
For s = 1 To oSourceBook.Sheets("Tabelle1").Range.Columns("A:T").Count

'Spalte 1 bis n - Tabelleninhalte des Arbeitsblattes "Tabelle1"
oTargetSheet.Cells(lErgebnisZeile, s).Value = _
oSourceBook.Sheets("Tabelle1").Columns("A:T").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
End Sub

2 Antworten

0 Punkte
Beantwortet von nighty Experte (6.6k Punkte)
hi xx ^^

auf anhieb faellt mir das auf !

sPfad = "C:\Users\XY\Desktop\AB"

am ende fehlt ein schraegstrich "\"

gruss nighty
0 Punkte
Beantwortet von nighty Experte (6.6k Punkte)
hi Jean ^^

ops hatte den namen im obigen post vergessen einzusetzen

dein code ist ok finde ich :-)

gruss nighty
...