VBA Zeile kopieren und darunter mehrfach einfügen

[Kuwer]

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

[VBA4Beginner]

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

[Kuwer]

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

[VBA4Beginner]

Hallo Uwe,

das ging aber wieder rasend schnell :19: und funktioniert genauso, wie ich es mir vorgestellt habe: DANKE!

Viele Grüße
Tamara