Mein Arbeitsblatt hängt sich auf

[Carloflip]

Ich habe ein Problem in meinem Programm und weiß nicht warum es harkt -
wenn ich eine Spalte oder eine Zelle in dem Blatt einfügen möchte hängt sich Excel auf.
Kann mir einer helfen das Problem zu entfernen. Das ist meine erste Frage hier im Forum !

Code:

'**********************************
'*
'*       BLATT 01
'*
'**********************************

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
 ' --------------------------------------------------
   Dim rngC, rngD, rngalt, test As Range
    Dim vntAfter As Variant, vntBefore As Variant, neu As Variant
     Dim strAddress As String
 ' --------------------------------------------------
 Set rngC = Me.Range("N4:N70")
 Set rngD = Me.Range("O4:O70")
 
 strAddress = Selection.Address
    vntAfter = Target.Value2
      With Application
        .EnableEvents = False
        .ScreenUpdating = False
        .Undo
    End With
    Range(strAddress).Select
    vntBefore = Target.Value2
    Target.Value2 = vntAfter
 ' --------------------------------------------------
    On Error GoTo ErrH:
 ' --------------------------------------------------
'Set rngC = Me.Range("N4:N70")
  If Not Intersect(Target, rngC) Is Nothing Then
    Application.EnableEvents = False
      Target.Offset(0, 6).Value = Target.Value       ' Spalte W - Neuer Wert
        Target.Offset(0, 8).Value = Date             ' Spalte Y
          Target.Offset(0, 9).Value = Time:          ' Spalte Z
         
'-----------------------------------------------------------------
           If IsArray(vntBefore) Then
        MsgBox vntBefore(1, 1)
    Else
        If vntAfter = vntBefore Then neu = 0 Else neu = vntAfter - vntBefore
         If neu = "" Then neu = 0
           MsgBox Selection.Cells(1).Address & " " & " Alter Wert " & vntBefore & " " & " Neuer Wert " & vntAfter & " Spiele " & neu
            End If
            Target.Offset(0, 10).Value = vntBefore
            Target.Offset(0, 11).Value = vntAfter
            Target.Offset(0, 12).Value = neu
           
        ' MsgBox Selection.Cells(1).Address ' Ausgabe der Akuellen Zeile
End If
 ' --------------------------------------------------
 'Set rngD = Me.Range("O4:O70")                       'Siegrate rngD
    If Not Intersect(Target, rngD) Is Nothing Then
        Application.EnableEvents = False
            Target.Offset(0, 6).Value = Target.Value 'Spalte U
 '---------------------------------------------------------------
                If vntAfter = vntBefore Then neu = 0 Else neu = vntAfter - vntBefore
                    If neu = "" Then neu = 0
 MsgBox " Alter Wert " & Format(vntBefore, "0.00 %") & " " & " Neuer Wert " & Format(vntAfter, "0.00 %") & " Spiele " & Format(neu, "0.00 %")
               ' End If
       
           Target.Offset(0, 12).Value = vntBefore '    format(wert, "0.0 %")- Format(5, "0.00%")
           Target.Offset(0, 13).Value = vntAfter
           Target.Offset(0, 14).Value = neu
          
     ' MsgBox Selection.Cells(1).Address ' Ausgabe der Akuellen Zeile
'---------------------------------------------------------------
  End If
 
  ' --------------------------------------------------
ErrH:
Application.DisplayAlerts = True
Application.StatusBar = True
Application.EnableEvents = True
'Application.sccreenUpdating = True
'Gesamtübersichtöffnen = False
If Err.Number > 0 Then
MsgBox "Fehlermeldung - Nr.: " & Err.Number & vbLf & vbCrLf & "  " & Erl & "  " & Err.Description, vbInformation + vbOKOnly, "Fehler Funktion F1 "
Else: End If
Exit Sub
End Sub

[WillWissen]

Hallo Carlo,

ich habe dein zweites (identisches) Thema, das wieder in einem falschen Unterforum war, ins Archiv verschoben. Bitte hier weitermachen.

[Storax]

Das am Anfang einfügen könnte helfen

If Target.Cells.CountLarge > 1 Then Exit Sub

[Carloflip]

Das war die Lösung - jetzt ist schluß mit Aufhängen. DANKE DANKE DANKE :)))