Schleife in vers. Datein kopieren

Hallo, ich benötige leider wieder etwas Hilfe für ein Makro. Pro Zeile werden die Informationen für die Zieldatei und die zu kopierenden Bereich geschrieben. Jetzt soll Zeile für Zeile die entsprechende Datei geöffnet und der Bereich kopiert werden.
Beispiel:
Quelle (offene Excel Datei):
Tabelle1 wird das Makro ausgeführt und dort stehen die Informationen, was wohin kopiert werden soll.
Tabelle3 enthält die Daten die kopiert werden sollen in die Zieldatei.

C3: Pfad-Ziel
D3: Dateiname-Ziel
E3: Blattname-Ziel
M3: Anfangszeile in Tabelle3 ab der kopiert werden soll (ab Spalte B)
N3: Endzeile in Tabelle3 bis zu der kopiert werden soll (bis Spalte AG)
H3: Zeile in der Zieldatei ab der eingefügt werden soll (ab Spalte A)

Diese Prozedur soll er bis zur letzten Zeile in der Quelle Tabelle1 machen. Wenn nötig kann ich auch noch die Anzahl der Durchläufe/Datein angeben oder sonst was.

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub a() Dim Wb As Workbook: Set Wb = ThisWorkbook Dim WsI As Worksheet: Set WsI = Wb.Worksheets("Tabelle1") Dim WsQ As Worksheet: Set WsQ = Wb.Worksheets("Tabelle3") Dim WbZ As Workbook, WsZ As Worksheet Dim Pfad$, Datei$, i& Application.ScreenUpdating = False With WsI For i = 3 To .Cells(.Rows.Count, 3).End(xlUp).Row Pfad = .Cells(i, 3) Datei = .Cells(i, 4) Set WbZ = Workbooks.Open(Pfad & Datei) Set WsZ = WbZ.Worksheets(.Cells(i, 5).Text) With WsQ .Range("B" & .Cells(i, 13).Value & ":AG" & .Cells(i, 14).Value).Copy _ WsZ.Cells(WsI.Cells(i, 8).Value, 1) End With WbZ.Save WbZ.Close Next i End With End Sub

Sub a() Dim Wb As Workbook: Set Wb = ThisWorkbook Dim WsI As Worksheet: Set WsI = Wb.Worksheets("Tabelle1") Dim WsQ As Worksheet: Set WsQ = Wb.Worksheets("Tabelle3") Dim WbZ As Workbook, WsZ As Worksheet Dim Pfad$, Datei$, i&, cpy$ Application.ScreenUpdating = False With WsI For i = 3 To .Cells(.Rows.Count, 3).End(xlUp).Row Pfad = .Cells(i, 3) Datei = .Cells(i, 4) Set WbZ = Workbooks.Open(Pfad & Datei) Set WsZ = WbZ.Worksheets(.Cells(i, 5).Text) With WsQ cpy = "B" & .Cells(i, 13).Value & ":AG" & .Cells(i, 14).Value .Range(cpy).Copy WsZ.Cells(WsI.Cells(i, 8).Value, 1) End With WbZ.Save WbZ.Close Next i End With End Sub

Sub a() Dim Wb As Workbook: Set Wb = ThisWorkbook Dim WsI As Worksheet: Set WsI = Wb.Worksheets("Tabelle1") Dim WsQ As Worksheet: Set WsQ = Wb.Worksheets("Tabelle3") Dim WbZ As Workbook, WsZ As Worksheet Dim Pfad$, Datei$, i&, cpy$ Application.ScreenUpdating = False With WsI For i = 3 To .Cells(.Rows.Count, 3).End(xlUp).Row Pfad = .Cells(i, 3) Datei = .Cells(i, 4) Set WbZ = Workbooks.Open(Pfad & Datei) Set WsZ = WbZ.Worksheets(.Cells(i, 5).Text) With WsQ cpy = "B" & WsI.Cells(i, 13).Value & ":AG" & WsI.Cells(i, 14).Value .Range(cpy).Copy WsZ.Cells(WsI.Cells(i, 8).Value, 1) End With WbZ.Save WbZ.Close Next i End With End Sub

Beliebteste Forumthreads (12 Monate)

Schleife in vers. Datein kopieren

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Schleife in vers. Datein kopieren

7 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)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread