Private Function Zusammenstellen()
 
    Dim r() As Range
    'Dim Kopier_Bereich As Range     'dieser Bereich wird kopiert
 
i = 2
X = 1
 
'Startinitialisierung
ReDim r(1)
 
'Den zu kopierenden Bereich zusammenstellen
With Workbooks("zusammen.xls").Worksheets("Temp")
    Do Until .Cells(akt_dat_zeile, i) = ""
 
    Set r(X) = Range(.Cells(akt_dat_zeile, i) & ":" & .Cells(akt_dat_zeile, i))
    'MsgBox r(X).Value
 
    'zur nächsten Spalte springen
    i = i + 1
    X = X + 1
    ReDim Preserve r(X)
 
    Loop
End With
 
 
'die Datentabelle wieder aktivieren
Workbooks("Test.xls").Activate
Worksheets("Daten").Activate
 
Set Kopier_Bereich = Union(r(1), r(2), r(3), r(4), r(5), r(6), r(7), r(8), r( _
  9), r(10), r(11))
Kopier_Bereich.Select
Kopier_Bereich.Copy
 
 
'manuelle Zusammenstellung der Daten
    'Range( 
    ' "H:H,J:J,N:N,AA:AA,BD:BD,BF:BF,BG:BG,BL:BL,BM:BM,BO:BO,B:B,C:C").Select
    'Range("BO1").Activate
 
'Die Daten in das Sortierblatt einfügen
    Windows("Zusammen.xls").Activate
    Worksheets("Tabelle1").Activate
    Cells(1, 1).Select
    ActiveSheet.Paste
 
End Function

Hier muss ich mir noch etwas schlaues f?r suchen