Makro geht und geht doch nicht

Hallo VBA-Profis,
ich wollte einem anderen Forumsmitglied hier helfen und habe auch alles soweit hinbekommen, aber an einem Problem bin ich gerade verzweifelt.
In der Datei:

Die Datei https://www.herber.de/bbs/user/55435.xls wurde aus Datenschutzgründen gelöscht

wird beim Ändern der Zelle "C5" ein Worksheet-Change-Ereignis ausgelöst. Das ablaufende Makro stoppt mit Laufzeitfehler 1004 (Die Methode 'Range' für das Objekt '_Worksheet' ist fehlgeschlagen). Wenn ich nun per 'debuggen' in den VBA-Editor gehe, die markierte Zeile mit F8 bestätige und anschließend das Makro bis zum Ende durchlaufen lasse, wird alles wie gewünscht, ohne weitere Fehlermeldung durchgeführt, auch das Ergebnis stimmt.
Ein testhalber eingefügtes "On Error Resume Next" hat nix gebracht, ganz im Gegenteil, dann werden einige Schritte des Makros gar nicht ausgeführt.
Ich habe auch versucht, das Makro in einem Modul manuell auszuführen, auch das scheiterte mit Fehlermeldungen.
Vielleicht weiß ja einer von euch eine Lösung, weil ich definitiv am Ende bin.
Danke und Gruß
David

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo David,
das ein AddIn aktiviert sein muss Stand nicht im Beitrag. Ich habe es jetzt aktiviert. Ich habe jetzt mal den Zustand nur ausgelesen und das Makro läuft durch.


Option Explicit
Private Sub worksheet_change(ByVal Target As Range)
Dim rc As Range
Dim BoZustand As Boolean
BoZustand = AddIns("Analyse-Funktionen").Installed
Const tThisRange = "C8:C38,H8:H38,N8:N38"
If Target.Address  "$C$5" Then Exit Sub
ActiveSheet.Unprotect
Application.EnableEvents = False
Application.ScreenUpdating = False
ActiveSheet.Name = _
Format(Range("C5"), "mmm.yy") & " bis " & Format(Range("N5"), "mmm.yy")
Range("B2") = Fix(Month(Range("C5")) / 4) + 1 & ". Quartal"
Range("D8:D38,I8:I38,O8:O38").ClearContents
Range(tThisRange).Formula = "=TRIM(IF((5-WEEKDAY(A8,2))-SUMPRODUCT(" _
& "(feiertagsliste>=A8)*(feiertagsliste5;NICHT(ISTNV(VERGLEICH(A8;feiertagsliste;0))));"""";$R$4)))"
For Each rc In Range(tThisRange)
rc.Offset(, 1).Copy
rc.Offset(, 1).PasteSpecial Paste:=xlPasteValues
If IsError(rc.Offset(, 1)) Then rc.Offset(, 1).ClearContents
If IsError(rc) Then
rc.ClearContents
Else
If rc = "" Then
rc.ClearContents
Else
rc = rc
End If
End If
Next
Application.CutCopyMode = False
Application.ScreenUpdating = True
Application.EnableEvents = True
ActiveSheet.Protect
End Sub

Gruß Hajo

Private Sub worksheet_change(ByVal Target As Range) Dim rc As Range Dim tThisRange As Range Set tThisRange = Range("C8:C38,H8:H38,N8:N38") If Target.Address "$C$5" Then Exit Sub ActiveSheet.Unprotect Application.EnableEvents = False Application.ScreenUpdating = False ActiveSheet.Name = _ Format(Range("C5"), "mmm.yy") & " bis " & Format(Range("N5"), "mmm.yy") Range("B2") = Fix(Month(Range("C5")) / 4) + 1 & ". Quartal" Range("D8:D38,I8:I38,O8:O38").ClearContents tThisRange.Formula = "=TRIM(IF((5-WEEKDAY(A8,2))-SUMPRODUCT(" _ & "(feiertagsliste>=A8)*(feiertagsliste5;NICHT(ISTNV(VERGLEICH(A8;feiertagsliste;0))));"""";$R$4)))" For Each rc In tThisRange rc.Offset(, 1).Copy rc.Offset(, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, _ Transpose:=False If IsError(rc.Offset(, 1)) Then rc.Offset(, 1).ClearContents If IsError(rc) Then rc.ClearContents Else If rc = "" Then rc.ClearContents Else rc = rc End If End If Next Application.ScreenUpdating = True Application.EnableEvents = True ActiveSheet.Protect End Sub

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

303 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Makro geht und geht doch nicht

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

303 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread