Hallo,
probiere mal so:
Sub aab()
Dim lngZ As Long
Dim strE As String
For lngZ = 30000 To 1 Step -1
strE = Left(Cells(lngZ, "L").Value, 1)
If IsNumeric(strE) Then
If CLng(strE) > 1 Then
Rows(lngZ + 1).Resize(CLng(strE) - 1).Insert
Cells(lngZ, 1).Resize(, 2).Copy Cells(lngZ + 1, 1).Resize(CLng(strE) - 1, 2)
End If
End If
Next lngZ
Application.CutCopyMode = False
End Sub
Gruß Uwe
Hallo Uwe,
zunächst mal ganz herzlichen Dank für deine schnelle Rückmeldung und perfekte Lösung - ich habe erst heute gesehen, dass du so schnell geantwortet hast, weil die Benachrichtigung in meinem Spam-Ordner gelandet war :22:
Es klappt also perfekt, allerdings habe ich dabei dann festgestellt, dass nur dann Zeilen eingefügt werden, wenn der Wert unter 10 ist. Da konnte ich mir aber selbst helfen, indem ich hier
strE = Left(Cells(lngZ, "L").Value,
2) den Wert auf zwei angepasst habe.
Jetzt fehlt mir eigentlich nur noch eine Möglichkeit, die neu eingefügten Zeilen mit irgendeiner Farbe zu füllen.
Ich habe dieses hier
Interior.Color = 10092543 an mehreren Stellen versucht, bekomme aber immer nur Fehlermeldungen. Da du mir - im Gegensatz zu mir - den Eindruck machst, als wärst du ein Profi, wäre es nett, wenn du mir das noch irgendwie einbasteln könntest.
Abermals herzlichen Dank und viele Grüße
Tamara
Hallo Tamara,
Sub aac()
Dim lngZ As Long
Dim strE As String
For lngZ = 30000 To 1 Step -1
strE = Left(Cells(lngZ, "L").Value, 2)
If IsNumeric(strE) Then
If CLng(strE) > 1 Then
Rows(lngZ + 1).Resize(CLng(strE) - 1).Insert
With Cells(lngZ + 1, 1).Resize(CLng(strE) - 1, 2)
Cells(lngZ, 1).Resize(, 2).Copy .Cells
.Interior.Color = 10092543
End With
End If
End If
Next lngZ
Application.CutCopyMode = False
End Sub
Gruß Uwe
Hallo Uwe,
das ging aber wieder rasend schnell :19: und funktioniert genauso, wie ich es mir vorgestellt habe: DANKE!
Viele Grüße
Tamara