|
Hallo megawunk,
Ich habe die Tabellenblätter "1" - "11" benannt.
Der folgende Code sollte das erreichen, was Du beschrieben hast:
Sub EintraegeKopieren()
Dim ws As Worksheet
Dim wsTarget As Worksheet
Dim rngSource As Range
Dim i As Integer
Dim lr As Long, lrTarget As Long, col As Long
Set wsTarget = Sheets("11")
For i = 3 To 9
Set ws = Sheets(i)
'Letzte Zeile im Sheet(11) ermitteln
lrTarget = wsTarget.Cells(Rows.Count, 1).End(xlUp).Row
With ws
'Letzte Zeile im jeweiligen Sheet ermitteln
lr = .Cells(Rows.Count, 1).End(xlUp).Row
'Spalte Zeile im jeweiligen Sheet ermitteln
col = .Cells(17, Columns.Count).End(xlToLeft).Column
'Prüfen, ob ab Zeile 17 Werte im jeweiligen Sheet stehen
If lr >= 17 Then
'Bereich von Zeile 17 bis zur letzten verwendeten Zeile festlegen
Set rngSource = .Range(.Cells(17, 1), .Cells(lr, col))
'Einträge kopieren und am Ende in Sheet("11") einfügen
rngSource.Copy Destination:=wsTarget.Cells(lrTarget + 1, 1)
End If
End With
Next i
End Sub
Ich hoffe es hilft.
Viele Grüße
Kai
|