HERBERS
Excel-Forum
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Zum Forum Zum Forum Zum Forumthread Zum Forumthread Zum Archivthread Zum Archivthread Registrierung Registrierung Beispieldatei hochladen Beispieldatei hochladen
Forumbeitrag
Excel-Version des Fragestellers:
365 Business
Erfahrungslevel des Fragestellers:
Excel gut - VBA bescheiden
Dieter
26.10.2025 07:11:19
Läuft mega
Morgen Case,

ich konnte leider erst jetzt deinen Code testen, aber besser spät als nie :D Ich habe gerade ein paar Fälle ausprobiert, aber dein Code läuft top durch. Vielen Dank du hast mich gerettet. Dir noch einen schönen Sonntag ;-)
Beim Antworter bedanken Als gefällt mir melden Als hervorragend melden
Als Antwort auf diesen Beitrag
Case
24.10.2025 19:20:34
Probiere diesen...
Moin Dieter, :-)

... Code: ;-) 

Option Explicit

Public Sub Main()

    Dim objXlMappe As Object

    Dim objXlSheet As Object

    Dim blnFound As Boolean

    Dim objXlApp As Object

    Dim objWBook As Object

    Dim lngLastRow As Long

    Dim strPath As String

    strPath = "C:\Temp\Arbeitsdokument.xlsx"

    On Error Resume Next

    Set objXlApp = GetObject(, "Excel.Application")

    On Error GoTo Fin

    If objXlApp Is Nothing Then

        Set objXlApp = CreateObject("Excel.Application")

    End If

    For Each objWBook In objXlApp.Workbooks

        If StrComp(objWBook.FullName, strPath, vbTextCompare) = 0 Then

            Set objXlMappe = objWBook

            blnFound = True

            Exit For

        End If

    Next objWBook

    If Not blnFound Then

        Set objXlMappe = objXlApp.Workbooks.Open(strPath)

    End If

    Set objXlSheet = objXlMappe.Sheets("Tabelle1")

    With objXlSheet

        lngLastRow = .Cells(.Rows.Count, 2).End(-4162).Row + 1 ' xlUp

        If lngLastRow < 17 Then lngLastRow = 17

        .Cells(lngLastRow, 2).Value = "NurEinTest"

    End With

    objXlMappe.Save

    objXlApp.Visible = True

Fin:

    If Err.Number > 0 Then MsgBox "Error: " & Err.Number & " " & Err.Description

    Set objXlSheet = Nothing

    Set objXlMappe = Nothing

    Set objXlApp = Nothing

End Sub

Der sollte eigentlich alles "erschlagen". ;-)

Starte aber deine Kiste mal neu. Falls du schon viel mit "CreateObject" gearbeitet hast (oder schau mal in den Task-Manager. Nicht dass da noch Excel-Leichen sind). ;-)

Servus
Case
Folgenachrichten
Zum Forumthread
Antwort auf Beitrag erstellen
Beispieldatei hochladen