Private Function Zusammenstellen()
Dim kopier_spalten As Excel.Range
i = 2
'Den zu kopierenden Bereich zusammenstellen
With Workbooks("Zusammen.xls").Worksheets("Temp")
    Do Until .Cells(akt_dat_zeile, i) = ""
        If i = 2 Then
            Set kopier_spalten = .Cells(akt_dat_zeile, i).EntireColumn ' NEU 
            ' ist .EntireColumn
        Else
            Set kopier_spalten = Union(kopier_spalten, .Cells(akt_dat_zeile, _
              i).EntireColumn) ' NEU ist .EntireColumn
        End If
        'zur nächsten Spalte springen
        i = i + 1
'        Cells(akt_dat_zeile, i).Select
    Loop
End With
' Du kannst Die Spalten auch markiren, musst Du aber nicht
kopier_spalten.select
kopier_spalten.Copy Worksheets("Tabelle1").Cells(1, 1)
End Function

Sub Zusammenstellen()
Dim COL As Excel.Range
Dim RAG As Excel.Range
For Each COL In Worksheets("Sheet1").Columns
    COL.Select  ' nur damit man sieht, dass etwas passiert
    If COL.Cells(1).Text = "" Then Exit For
    If COL.Column > 1 Then ' Du wolltest mit Spalte 2 anfangen
        If RAG Is Nothing Then
            Set RAG = COL
        Else
            Set RAG = Union(RAG, COL)
        End If
        RAG.Select ' nur damit man sieht, dass etwas passiert
    End If
Next COL
RAG.Copy Worksheets("Sheet2").Cells(1)
End Sub