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