|
Hallo zusammen,
ich versuche aus mehreren Dateien auszulesen und zu kopieren, dass funktioniert soweit mit der ersten Datei auch gut, aber er springt nicht weiter :(
Vielleicht hat jemand von Euch ja eine Idee warum er nicht weiter springt
'Prozedur
Public Sub Import()
'Deklaration Variablen
Dim strPfadDateiQuelle As String 'adresse zb. C:\Ordner\neuer....
Dim strPfadDateiZiel As String 'adresse zb. C:\Ordner\neuer....
Dim strNameDateiAktuell As String 'Dateiname zb. win.xlsx
Dim dateDatumQuelle As Date 'Variable zur Verwendung eines Datums zb.: yyyy-mm-dd
Dim lngZaehlerZeileQuelle As Long 'Zähler für Zeile
Dim lngZaehlerSpalteQuelle As Long 'zähler für spalte
Dim lngZaehlerZeileZiel As Long 'Zähler für Zeile
Dim lngZaehlerSpalteZiel As Long 'zähler für spalte
'Code
strPfadDateiQuelle = "O:\xxxxx\1st_XX\Team_XXX\02_Auswertung_XXX\"
strPfadDateiZiel = "H:\xxxx\Projekte\Bla-Übersicht\"
'Schleife Datei
lngZaehlerZeileZiel = 2
lngZaehlerSpalteZiel = 1
For dateDatumQuelle = DateSerial(2017, 1, 1) To DateSerial(2017, 12, 31) Step 1 'FOR000
strNameDateiAktuell = "AuswXXX_KW2017" & Format(Format(dateDatumQuelle, "-ww"), "00") & "_Team_XXX" & ".xlsx"
Workbooks.Open strPfadDateiQuelle & strNameDateiAktuell
'Schleife Zeilen
lngZaehlerZeileQuelle = 2
lngZaehlerSpalteQuelle = 1
Do Until (Workbooks(strNameDateiAktuell).Worksheets("AuswMA").Cells(lngZaehlerZeileQuelle, lngZaehlerSpalteQuelle) = "") 'DO000
'Schleife Spalten
Do Until (Workbooks(strNameDateiAktuell).Worksheets("AuswMA").Cells(lngZaehlerZeileQuelle, lngZaehlerSpalteQuelle) = "") 'DO001
ThisWorkbook.Worksheets("Rohdaten XXX").Cells(lngZaehlerZeileZiel, lngZaehlerSpalteZiel) = _
Workbooks(strNameDateiAktuell).Worksheets("AuswMA").Cells(lngZaehlerZeileQuelle, lngZaehlerSpalteQuelle)
lngZaehlerSpalteZiel = lngZaehlerSpalteZiel + 1
lngZaehlerSpalteQuelle = lngZaehlerSpalteQuelle + 1
Loop 'DO001
lngZaehlerZeileZiel = lngZaehlerZeileZiel + 1
lngZaehlerZeileQuelle = lngZaehlerZeileQuelle + 1
lngZaehlerSpalteZiel = 1
lngZaehlerSpalteQuelle = 1
Loop 'DO000
Workbooks(strNameDateiAktuell).Close
Next 'FOR000
End Sub
|