Antwort
Nochmal übersichtlicher
Option Explicit
Sub Makro2() ' ' Makro2 Makro '
Dim lZeile_A As Long
Dim lZeileD As Long: lZeileD = 0
For lZeile_A = 1 To 100 'Auswahl Zeile A1 bis A100
If Trim(.Range("A" & lZeile_A).Value) <> "" Then 'Solanga A ungleich LEER
lZeile_D = lZeile_D + 1 'Zeile D immer eine Spalte runter
Sheets("Importe").Select 'Arbeitsblatt Importe ausgweählt
.Range("A" & lZeile_A).Copy 'Zeile Kopieren
Sheets("Sammlung").Select 'Arbeitsblatt Sammlung ausgewählt
.Range("D" & lZeile_D).PasteSpecial 'In Zeile D einfügen
End If ' Beende IF-Schleife
Next lZeile_A 'Cursor an die nächste freie A Spalte stellen
End Sub