Automatisch Zeilen einfügen

[Kuwer]

Hallo,

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Count = 1 Then

  If Cells(Target.Row + 1, 2).Value = "Summe:" Then

    If Len(Target.Value) Then

      On Error Resume Next

      Application.EnableEvents = False

      Target.EntireRow.Copy

      Target.EntireRow.Offset(1).Insert

      Target.Offset(1) = ""

      Cells(Target.Row + 1, 2) = ""

      Application.CutCopyMode = False

      Application.EnableEvents = True

      On Error GoTo 0

    End If

  End If

End If

End Sub

Gruß Uwe