neues Worksheet kann nicht an Sub übergeben werden

Guten Tag zusammen,

ich möchte ein Worksheet einem Sub übergeben, um darin weiter arbeiten zu können. Ist das Worksheet bereits vorhanden, funktioniert der Aufruf des Subs und dieses läuft auch ohne Probleme durch. Muss das Worksheet aber zunächst erstellt werden, kommt es beim Aufruf

Datenbearbeiten zielWorksheet, aktuelleKostenstelle, zielDateiletzteZeile.Row + 3

zur Fehlermeldung: "Objektvariable oder With-blockvariable nicht festgelegt." Das neue Worksheet wird allerdings korrekt angelegt.
Ich habe an verschiedenen Stellen das Workbook gespeichert bzw. auch schon gespeichert und erneut geöffnet. Alles leider ohne Erfolg.
Auch ChatGPT habe ich schon dazu befragt. Ich weiß nicht, ob zu schlecht oder ungenau, aber hier konnte mir leider auch nicht weitergeholfen werden.
Ich kann mir die Problematik leider nicht erklären und bin über jeden Input dankbar. :)

Da das Sub Datenbearbeiten größer wird, möchte ich es ungern direkt im selben Sub lösen.

Sub Datenkopieren(startZeile As Long, letzteZeile As Long, ByVal quellWorkbook As Workbook, quellWorksheetName As String, zielDatei As String)



    Dim zielWorksheet As Worksheet

    Dim aktuelleKostenstelle As String

    Dim zielWorkbook As Workbook

    Dim zielDateiletzteZeile As Variant

    Dim i As Long

    

    aktuelleKostenstelle = quellWorkbook.Sheets(quellWorksheetName).Cells(startZeile, 2).Value

    

    On Error Resume Next

        Set zielWorkbook = Workbooks.Open(zielDatei)

    On Error GoTo 0

    

    ' Überprüfen, ob das Blatt bereits existiert

    If Not BlattExistiert(zielWorkbook, aktuelleKostenstelle) Then

        With zielWorkbook

            .Sheets.Add after:=.Sheets(.Sheets.Count)

            .ActiveSheet.Name = aktuelleKostenstelle

        End With

    End If

    Set zielWorksheet = zielWorkbook.Sheets(aktuelleKostenstelle)

    zielWorkbook.Save

        

    ' Finde die Position der letzten Zelle mit Beschriftung in Spalte A

    On Error Resume Next

        Set zielDateiletzteZeile = zielWorksheet.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious)

    On Error GoTo 0

    

    ' Daten in zielWorksheet speichern

    If Not zielDateiletzteZeile Is Nothing Then

        zielWorksheet.Cells(zielDateiletzteZeile.Row + 3, 1).Value = Date

        quellWorkbook.Sheets(quellWorksheetName).Range("B1:Z2").Copy Destination:=zielWorksheet.Cells(zielDateiletzteZeile.Row + 3, 1)

        quellWorkbook.Sheets(quellWorksheetName).Range("B" & startZeile & ":" & "Z" & letzteZeile).Copy Destination:=zielWorksheet.Cells(zielDateiletzteZeile.Row + 5, 1)

    Else

        zielWorksheet.Cells(1, 1).Value = Date

        quellWorkbook.Sheets(quellWorksheetName).Range("B" & startZeile & ":" & "Z" & letzteZeile).Copy Destination:=zielWorksheet.Range("A2")

    End If



    Datenbearbeiten ByVal zielWorksheet, aktuelleKostenstelle, zielDateiletzteZeile.Row + 3

    

    zielWorkbook.Save

    zielWorkbook.Close



End Sub

Sub Datenbearbeiten(ByVal zielSheet As Worksheet, aktuelleKostenstelle As String, ersteZeile As Long)

    

    Dim letzteZeile As Long



    letzteZeile = zielSheet.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

    

    zielSheet.Range("Q" & ersteZeile & ":X" & letzteZeile).Delete Shift:=xlToLeft

    zielSheet.Range("N" & ersteZeile & ":O" & letzteZeile).Delete Shift:=xlToLeft

    

End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Datenkopieren(ByVal quellWorksheet As Worksheet, zielDatei As String, startZeile As Long, letzteZeile As Long) Dim zielWorksheet As Worksheet Dim zielWorkbook As Workbook Dim zielDateiletzteZeile As Range Dim neueLetzteZeile As Long ' Datei öffnen. Wenn nicht gefunden, aussteigen Set zielWorkbook = Datei_öffnen(zielDatei) If zielWorkbook Is Nothing Then MsgBox "Datei """ & zielDatei & """ wurde nicht gefunden." Exit Sub End If ' Überprüfen, ob das Blatt bereits existiert, wenn nicht einbauen Set zielWorksheet = Blatt_holen(zielWorkbook, quellWorksheet.Cells(startZeile, 2).Value) ' Finde die Position der letzten Zelle mit Beschriftung in Spalte A Set zielDateiletzteZeile = zielWorksheet.Cells(Rows.Count, 1).End(xlUp) ' Daten in zielWorksheet speichern If zielDateiletzteZeile.Row > 1 Then Set zielDateiletzteZeile = zielDateiletzteZeile.Offset(3, 0) zielDateiletzteZeile.Value = Date quellWorksheet.Range("B1:Z2").Copy Destination:=zielDateiletzteZeile.Offset(1, 0) quellWorksheet.Range("B" & startZeile & ":" & "Z" & letzteZeile).Copy Destination:=zielDateiletzteZeile.Offset(2, 0) ' Bereinigen neueLetzteZeile = zielWorksheet.Cells(Rows.Count, 1).End(xlUp).Row zielWorksheet.Range("Q" & zielDateiletzteZeile.Row & ":X" & neueLetzteZeile).Delete Shift:=xlToLeft zielWorksheet.Range("N" & zielDateiletzteZeile.Row & ":O" & neueLetzteZeile).Delete Shift:=xlToLeft ' Speichern, schliessen zielWorkbook.Save zielWorkbook.Close End Sub Public Function Datei_öffnen(DateiName As String) As Workbook On Error Resume Next Set Datei_öffnen = Workbooks.Open(DateiName) End Function Public Function Blatt_holen(WB As Workbook, BlattName As String) As Worksheet Dim WS As Worksheet On Error Resume Next Set WS = WB.Worksheets(BlattName) If WS Is Nothing Then Set WS = WB.Worksheets.Add(after:=WB.Worksheets(WB.Worksheets.Count)) WS.Name = BlattName End If Set Blatt_holen = WS End Function

Beliebteste Forumthreads (12 Monate)

neues Worksheet kann nicht an Sub übergeben werden

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

neues Worksheet kann nicht an Sub übergeben werden

11 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread