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