Hallo Community,
ich bin ein zimlicher Laie in VBA aber was nicht ist kann ja noch werden ;-).
Nun habe ich ein Problem mit Excel und selbst Google konnte mir nicht helfen.
Ich hoffe ihr könnt es!!!
OS ist XP SP3
Excel ist 2003 und ebenfalls up-to-date
Es handelt sich um eine Arbeitsmappe mit 3 Datenblättern.
Das erste ruft Daten von einem Sharepoint ab (funktioniert einwandfrei)
Die anderen beiden Blätter zeigen die Daten jeweils gefiltert und formatiert an.
Wenn ich das Dokument öffne kommt keine Fehlermeldung (egal welches Arbeitsblatt dann offen ist).
Sobald ich aber dann die Arbeitsblätter wechsel, komt jedes mal folgende Fehlermeldung:
Microsoft Visual Basic
Laufzeitfehler '1004':
Die Methode 'Range' für das Objekt '_Global' ist fehlgeschlagen.
Der Debugger makiert folgenden Code als fehlerhaft:
If Range("DataStart").Parent.Name <> Sh.Name Then
Der gesamte Code lautet:
Option Explicit
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If Range("DataStart").Parent.Name <> Sh.Name Then
Dim rngCrit As Range
On Error Resume Next
Set rngCrit = Sh.Range("DataCrit")
On Error GoTo 0
If Not rngCrit Is Nothing Then
Filter Sh
End If
End If
ErrorHandler:
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Range("DataStart").Parent.Name <> Sh.Name Then
Dim rngAct As Range
Set rngAct = ActiveCell
On Error GoTo ErrorHandler
Set Target = Intersect(Target, Sh.Range(Sh.Range("DataCrit").Row & ":" & Sh.Range("DataGoal").Row - 1).EntireRow)
If Not Target Is Nothing Then
Filter Sh
Application.GoTo rngAct
End If
End If
ErrorHandler:
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Private Sub Filter(Sh As Object)
On Error GoTo ErrorHandler
Application.ScreenUpdating = False
Application.EnableEvents = False
Dim lngRows As Long
Dim rngGoalData As Range
With Sh
lngRows = .Range(.Range("DataCrit").Row & ":" & .Range("DataGoal").Row - 1). _
Find(What:="*", _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
Set rngGoalData = .Range("DataGoal").CurrentRegion
If rngGoalData(1, 1).Row < .Range("DataGoal").Row Then
rngGoalData.Offset(.Range("DataGoal").Row - 1, 0).Clear
Else
.Range("DataGoal").CurrentRegion.Clear
End If
Range("DataStart").CurrentRegion.AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=.Range(.Range("DataCrit").Row & ":" & lngRows), _
CopyToRange:=.Range("DataGoal"), _
Unique:=False
End With
ErrorHandler:
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Public Sub ReSharpen()
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
|