AW: Zeile einfügen/ kopieren
21.06.2014 15:16:12
Daniel
Hi
probier mal das, getestet mit dem IST-Teil deiner Beispieldatei.
Sub test()
Dim Z As Long
Dim Anz As Long
Dim i As Long
For Z = Cells(Rows.Count, 3).End(xlUp).Row To Cells(Rows.Count, 3).End(xlUp).End(xlUp).Row Step _
-1
If Cells(Z, 5).Value "" Then
Anz = Range(Cells(Z, 5), Cells(Z, 5).End(xlToRight)).Cells.Count / 2
Rows(Z + 1).Resize(Anz - 1).Insert shift:=xlDown
For i = 1 To Anz - 1
Cells(Z, 5 + 2 * i).Resize(, 2).Copy Cells(Z + i, 5)
Next
Cells(Z, 7).Resize(1, (Anz - 1) * 2).Clear
End If
Next
End Sub
damit der Zellbereich richtig ermittelt wird, dürfen in Spalte C unterhalb der Fragen keine weiteren Zellen befüllt sein, die Fragen in Spalte C müssen lückenlos stehen.
Gruß Daniel