Spalteninhalt einfügen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Makro3() Dim strPath As String Dim strExt As String Range("A1:A2887").Select Selection.Copy strPath = "C:\Temp\Test\" strExt = "*.xlsm" Dim strFile As String If strPath = "" Then Exit Sub Else strFile = Dir(strPath & strExt) Do While Len(strFile) > 0 Workbooks.Open Filename:=strPath & strFile Sheets("Test").Select Range("T1").Select ActiveSheet.Paste Workbooks(strFile).Close strFile = Dir() Loop End If End Sub

Sub Makro3() Dim strPath As String Dim strExt As String Dim strFile As String Range("B1:B933").Select Selection.Copy strPath = "C:\Temp\Test\" 'Pfad des Verzeichnisses ggf. anpassen strExt = "*.xlsm" 'Dateiextension ggf. anpassen If strPath = "" Then Exit Sub Else strFile = Dir(strPath & strExt) Do While Len(strFile) > 0 Workbooks.Open Filename:=strPath & strFile Sheets("Data").Select Range("BS6").Select ActiveSheet.Paste Workbooks(strFile).Close strFile = Dir() ' nächste Datei Loop End If End Sub

Hallo Peter,
leider sagst Du nicht, in welcher Zeile des Codes der Fehler erscheint. So bleibt nur das Raten - mein erster Versuch: die Datei mit dem Makro ist in dem gleichen Pfad wie die zu ändernden Dateien oder eine gleichnamige befindet sich darunter. Aber es gibt noch genug andere mögliche Gründe (z. B. Blattschutz beim Ziel, die Zieldateien haben gar kein Blatt "data" etc.)
Ich habe Dein Makro mit ein paar Testdateien durchgespielt, aber ohne irgendein Problem.
Noch ein Tipp: mit Workbooks(strFile).Close True sparst Du Dir, das Schließen / Speichern jeder Datei zu bestätigen. Das könnte dann, mit noch ein paar Veränderungen, die sich günstig auf die Ausführungsgeschwindigkeit auswirken sollten (wie z.B. der Verzicht auf .select), ungefähr so aussehen:

Sub Makro3b()
Dim strPath As String
Dim strExt As String
Dim strFile As String
Dim Zieldatei As Workbook
strPath = "C:\Temp\Test\" 'Pfad des Verzeichnisses ggf. anpassen
strExt = "*.xlsm"       'Dateiextension ggf. anpassen
If strPath = "" Then
Exit Sub
Else
strFile = Dir(strPath & strExt)
Do While Len(strFile) > 0
Set Zieldatei = Workbooks.Open(Filename:=strPath & strFile)
ThisWorkbook.Sheets(1).Range("B1:B933").Copy Zieldatei.Sheets("Data").Range("BS6")
Zieldatei.Close True
strFile = Dir() ' nächste Datei
Loop
End If
End Sub

Das wird aber Dein Problem wahrscheinlich nicht lösen. Und vor dem Ausprobieren von meinem Code musst Du prüfen, ob meine Annahme, dass die zu kopierenden Daten auf dem ersten Blatt Deiner Makro-Datei stehen, zutrifft und ggfs. die Zahl in ThisWorkbook.Sheets(1) korrigieren.
Gruß, Jürgen

Sub Makro3b() Dim strPath As String Dim strExt As String Dim strFile As String Dim Zieldatei As Workbook strPath = "C:\Temp\Test\" 'Pfad des Verzeichnisses ggf. anpassen strExt = "*.xlsm" 'Dateiextension ggf. anpassen If strPath = "" Then Exit Sub Else strFile = Dir(strPath & strExt) Do While Len(strFile) > 0 Set Zieldatei = Workbooks.Open(Filename:=strPath & strFile) ThisWorkbook.Sheets(1).Range("B1:B933").Copy Zieldatei.Sheets("Data").Range("BS6") Zieldatei.Close True strFile = Dir() ' nächste Datei Loop End If End Sub

Sub Makro3b() Dim strPath As String Dim strExt As String Dim strFile As String Dim Zieldatei As Workbook Dim rngQuelle As Range strPath = "C:\Temp\Test\" 'Pfad des Verzeichnisses ggf. anpassen strPath = "D:\Test\" 'Pfad des Verzeichnisses ggf. anpassen strExt = "*.xlsm" 'Dateiextension ggf. anpassen If strPath = "" Then Exit Sub Else Set rngQuelle = ActiveWorkbook.Sheets(1).Range("B1:B933") strFile = Dir(strPath & strExt) With Application .ScreenUpdating = False .EnableEvents = False End With Do While Len(strFile) > 0 Set Zieldatei = Workbooks.Open(Filename:=strPath & strFile) rngQuelle.Copy Destination:=Zieldatei.Sheets("Data").Range("BS6") Application.CutCopyMode = False Zieldatei.Close savechanges:=True strFile = Dir() ' nächste Datei Loop With Application .ScreenUpdating = True .EnableEvents = True End With End If End Sub

Beliebteste Forumthreads (12 Monate)

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Spalteninhalt einfügen

12 Beiträge zum Forumthread Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread