Laufzeitfehler '424': Objekt erforderlich
24.08.2016 11:35:07
Leonida
ich habe eine Excel-Tabelle mit Daten im ersten Tabellenblatt (die Datei hat mehrere Blätter) von A1:V507, die ich gerne durch einen Autofilter in Spalte F nach den Werten, die sich dort befinden, in einzelne Dateien splitten würde.
Das Tabellenblatt "Gesamtübersicht" besteht aus Datensätzen von Mitarbeitern und in Spalte F befindet sich die Führungskraft. Diese sollen den einzelnen Führungskräften geschickt werden.
Das an sich ist erstmal nicht so kompliziert, allerdings gibt es noch einige Schwierigkeiten in dieser Datei. Die Datensätze befinden sich in A1:V480 und von A481:V507 befindet sich eine zusätzliche Tabelle mit Formeln, die in jeder gesplitteten Datei vorhanden sein muss.
1. Die Spalten Q:V sollen komplett ausgeblendet werden, sich aber noch in den neuen Dateien befinden, da dort nicht sichtbare Formeln hinterlegt sein sollen. Dasselbe gilt für die Zeilen 482:494 und 496:507.
2. Die Liste wird nach den Führungskräften, also Werten in Spalte F, aufgeteilt, wobei sich zusätzlich der Bereich A481:V507 in jeder Datei befinden muss.
3. Alle Zellen außer K4:N(Zähle die Zeilen) sollen mit einem Passwort gesperrt sein.
4. Die Dateien sollen unter dem gleichen Pfad & "/" & "FK Tools" unter dem Namen der jeweiligen Führungskraft gespeichert werden.
Für mich als VBA-Anfänger war es gerade so möglich einen so speziellen Code zu schreiben, allerdings bin ich nicht sicher, ob er mich zum Ziel bringt.
Sub LB_Liste_splitten2()
Dim D As Object
Dim lz As Long
Dim v As Object
Dim wb As Workbook
Dim lng As Long
Dim line As Long
Application.ScreenUpdating = False
Set D = CreateObject("scripting.dictionary")
With Tabelle1
With .Range("A1:V507").CurrentRegion
lz = Cells(Rows.Count, 6).End(xlUp).Row
For Each v In Range("A4:V" & lz).Offset(1).Value
If v "" Then D(v) = 0
Next
For Each v In D.Keys
Set wb = Workbooks.Add(xlWBATWorksheet)
lng = Cells(Rows.Count, 10).End(xlUp).Row
Sheets("Gesamtübersicht").Range("A1:P" & lng).Copy
wb.Worksheets(1).Cells(1).PasteSpecial Paste:=xlPasteAll
wb.Worksheets(1).Cells(1).PasteSpecial Paste:=xlPasteColumnWidths
wb.Worksheets(1).Cells(1).PasteSpecial Paste:=xlPasteFormulas
With wb.Sheets(1)
line = Cells(Rows.Count, 1).End(xlUp).Row
.Range("A4:V" & line).AutoFilter 6, v
If .Range("F4:F" & lz).Cells.Value v Then _
EntireRow.Delete
.Range("K2:N" & line).Locked = False
.Protect "Era"
.AutoFilter
End With
wb.SaveAs ActiveWorksheet.Parent.Parent.Path & "\FK Tools" & "\" & v & ".xlsx", _
xlOpenXMLWorkbook
wb.Close False
Next
End With
End With
MsgBox "Finished!"
End Sub
Ich kann es leider auch nicht ausprobieren, da in folgender Zeile der "Laufzeitfehler '424': Objekt erforderlich" angezeigt wird:
For Each v In Range("A4:V" & lz).Offset(1).Value
Komischerweise habe ich einen ähnlichen Code für ein anderes Projekt, in dem die Zeilen bis zum Laufzeitfehler aber komplett identisch sind und der Code läuft einwandfrei. Warum dieser es nicht tut, bleibt mir ein Rätsel.
Ich habe mein Problem zwar schon in einer Antwort auf einen anderen Beitrag geschildert, habe darauf aber leider keine Antwort bekommen. Deshalb hoffe ich, dass mir jetzt eventuell jemand helfen kann.
Gruß Leonida
P.S.: Hier ist eine Beispiel-Datei, wie meine Datei aussieht.
https://www.herber.de/bbs/user/107774.xlsx