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)
        Else
            set Kopier_Spalten = union(Kopier_Spalten, .Cells(akt_dat_zeile, i))
End If
 
    'zur nächsten Spalte springen
    i = i + 1
    Cells(akt_dat_zeile, i).Select
    Loop
End With
 
kopier_spalten.copy Worksheets("Tabelle1").Cells(1,1)
end function

Private Function Zusammenstellen()
Dim CEL as excel.range
Dim RAG as excel.range
for each cel in Workbooks("Zusammen.xls").Worksheets("Temp").column( _
  akt_dat_zeile).cells
   if cel.text="" then exit for
   if cel.column>1 then set rag=union(RAG, CEL)
next CEL
 
RAG.copy Worksheets("Tabelle1").Cells(1)
end function