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