Hm,
zu spät gesehen das Torsten sich schon gemeldet hat, werde auch nicht weiteroptimieren.
Da es ein andere Ansatz ist (und das nicht ganz umsonst :)) poste Ich trotzdem mal:
Sub CopyA()
Dim rng As Range
'
With ThisWorkbook.Worksheets("Tabelle1")
'Tabelle2
Set rng = getRangeA(ThisWorkbook.Worksheets("Tabelle2"))
.Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(rng.Rows.Count, rng.Columns.Count).Value = rng.Value
'Tabelle3
Set rng = getRangeA(ThisWorkbook.Worksheets("Tabelle3"))
.Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(rng.Rows.Count, rng.Columns.Count).Value = rng.Value
End With
End Sub
Function getRangeA(wks As Worksheet) As Range
Dim rng As Range
With wks
Set rng = Intersect(.UsedRange, .Range("A4:T" & .Rows.Count))
End With
Set getRangeA = rng
End Function
|