Für Jakob Freitag
11.12.2006 12:17:43
Regina
Deine Frage war noch nicht beantwortet.
Leider bin ich erst jetzt dazu gekommen.
Ich habe es jetzt so weit eingerichtet, dass die Zeilen alle in die Datei1 kopiert werden.
die Pfade mußt Du ggf anpassen
Sub tabellenZusammenKopieren()
Dim i As Long
Dim c As Long
Dim tb1 As Worksheet
Dim tb2 As Worksheet
Dim ende1 As Long
Dim ende2 As Long
Workbooks.Open Filename:="C:\Datei1.xls"
Set tb1 = ActiveWorkbook.Worksheets(1)
ende1 = tb1.Cells(65536, 1).End(xlUp).Row 'von letzter Zeile aufwärts
Workbooks.Open Filename:="C:\Datei2.xls"
Set tb2 = ActiveWorkbook.Worksheets(1)
ende2 = tb2.Cells(65536, 1).End(xlUp).Row
tb2.Range("A1:AK" & ende2).Copy
tb1.Range("A65530").End(xlUp).Offset(1, 0).PasteSpecial
tb2.Activate
ActiveWorkbook.Close savechanges:=False
Workbooks.Open Filename:="C:\Datei3.xls"
Set tb2 = ActiveWorkbook.Worksheets(1)
ende2 = tb2.Cells(65536, 1).End(xlUp).Row
tb2.Range("A1:AK" & ende2).Copy
tb1.Range("A65530").End(xlUp).Offset(1, 0).PasteSpecial
tb2.Activate
ActiveWorkbook.Close savechanges:=False
Workbooks.Open Filename:="C:\Datei4.xls"
Set tb2 = ActiveWorkbook.Worksheets(1)
ende2 = tb2.Cells(65536, 1).End(xlUp).Row
tb2.Range("A1:AK" & ende2).Copy
tb1.Range("A65530").End(xlUp).Offset(1, 0).PasteSpecial
tb2.Activate
ActiveWorkbook.Close savechanges:=False
Workbooks.Open Filename:="C:\Datei5.xls"
Set tb2 = ActiveWorkbook.Worksheets(1)
ende2 = tb2.Cells(65536, 1).End(xlUp).Row
tb2.Range("A1:AK" & ende2).Copy
tb1.Range("A65530").End(xlUp).Offset(1, 0).PasteSpecial
tb2.Activate
ActiveWorkbook.Close savechanges:=False
Workbooks.Open Filename:="C:\Datei6.xls"
Set tb2 = ActiveWorkbook.Worksheets(1)
ende2 = tb2.Cells(65536, 1).End(xlUp).Row
tb2.Range("A1:AK" & ende2).Copy
tb1.Range("A65530").End(xlUp).Offset(1, 0).PasteSpecial
tb2.Activate
ActiveWorkbook.Close savechanges:=False
End Sub
Gruß Regina
Anzeige