|
Hallo an alle VBA Experten,
ich benötige Hilfe bei einem meiner Meinung nach wirklich sehr einfachen Code. Alle Google Ergebnisse liefern mir am Ende genau das was ich geschrieben habe.
Folgendes möchte ich tun: Dateien in einem Ordner der Reihe nach öffnen und bestimmte Werte in ein Zieldokument kopieren.
Die Dateien (aktuell 3 Stück E1.xls F1.xls G1.xls) sind im Ordner C:\Users\xy\Test read out ZESR\ZESR.
Die Zieldatei ist im Ordner: C:\Users\xy\Test read out ZESR.
Ich bin aktuell nur soweit, dass alles in Zelle B2 kopiert wird. Den nächsten Schritt es der Reihe nach in B2,B3,B4...zu kopieren hab ich noch nicht gelöst. Das ist gerade auch nicht das Problem.
Mein Problem besteht darin, dass die Schleife nach dem ersten Mal einfach abbricht. Ich kann mir das nicht erklären, es sind ja noch 2 Dateien übrig. Ich kriege auch keine Fehlermeldung, der erste Schritt klappt einwandfrei. Vielleicht kennt jemand dieses Problem?
Hier der Code:
Sub CopyandPaste()
Dim Pfad As String, Dateiname As String
Dim PfadOrg As String, DateinameOrg As String
Pfad = "C:\Users\xy\Test read out ZESR\ZESR\"
Dateiname = Dir(Pfad & "*.xls")
PfadOrg = "C:\Users\xy\Test read out ZESR\"
DateinameOrg = Dir(PfadOrg & "Read_out_ESR.xlsm")
Do While Dateiname <> ""
Workbooks.Open Filename:=Pfad & Dateiname
Workbooks(Dateiname).Sheets("Z-ESR Dia").Range("P37").Copy
Workbooks(DateinameOrg).Sheets("Sheet1").Range("B2").PasteSpecial xlPasteValues
Workbooks(Dateiname).Close SaveChanges:=False
Dateiname = Dir
Loop
End Sub
Wäre nett wenn mir hier jemand die Augen öffnen kann!
Danke und Grüße
TW
|