Private Function Zusammenstellen()
 
i = 2
 
'Den zu kopierenden Bereich zusammenstellen
With Workbooks("Zusammen.xls").Worksheets("Temp")
 
    Do Until Cells(akt_dat_zeile, i) = ""
 
        'Den Bereich erzeugen
        If i = 2 Then
            Kopier_Spalten = .Cells(akt_dat_zeile, i) & ":" & .Cells( _
              akt_dat_zeile, i)
        Else
            Kopier_Spalten = Kopier_Spalten & "," & .Cells(akt_dat_zeile, i) & _
              ":" & .Cells(akt_dat_zeile, i)
        End If
 
    'zur nächsten Spalte springen
    i = i + 1
    Cells(akt_dat_zeile, i).Select
    Loop
End With
 
 ActiveWorkbook.Range = Kopier_Spalten
 
'so funktionierts nicht
 '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
 
'so funktioniert es nicht
Range(Kopier_Bereich).Select
 
    Selection.Copy
 
'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