Hallo Zusammen,

falls jemand Ahnung hat, könnt Ihr euer Ergebnis teilen.

Ich habe einen Code zusammengebastellt, da ich VBA nur lesen und nicht schreiben kann. Der läuft/funktioniert bis auf den "Workbook.Close" bei mir "objSheet.Close"... unten der Code und ab dem Fett markierten Bereich zeigt das Programm einen Fehler 438 Objekt untertstüzt diese Eigenschaft oder Methode nicht...ohne diese Zeile funktioniert alles...

Bitte um Hilfe,

Freundliche Grüße

Schubi

Sub Makro() 

    Neues Excel Objekt     
    Dim objExcel As New Excel.Application
    'Sheet Objekt der jeweiligen Exceldatei
    Dim objSheet As Object
    'Hilfsvariablen
    Dim iRow As Long, j As Long
    Dim strDateipfad As String
    Dim strPfad As String
    Dim strDateiname As String
'   Dim wb As Workbook

    'Pfad in welchem die Dateien der zu
    'kopierenden Zellen sich befinden auswählen
    strPfad = ThisWorkbook.Path & Application.PathSeparator
    'Schleife welche den Zelleninhalt aller aufgelisteten
    'Dateien in mehrere Zellen des Hauptprogramms schreibt

    For iRow = 4 To Cells(Rows.Count, 4).End(xlUp).Row
        'Überprüfen, ob in Spalte "Dateiname" ein solcher eingetragen ist.
        '(der Arbeitsvorgang wird fortgesetzt)
        If Cells(iRow, 2) = "" Then 'Wenn Zelle in Spalte B Leer dann Exit
            Exit Sub
        Else
            strDateiname = Cells(iRow, 2)
            strDateipfad = strPfad & strDateiname & ".xlsm" '
            'Überprüfen, ob die in der Tabelle angegebene Datei vorhanden ist.
            '(der Arbeitsvorgang wird fortgesetzt)
            If Dir(strDateipfad) = "" Then
            Else

                objExcel.Workbooks.Open strDateipfad
                Set objSheet = objExcel.Sheets("Schnittstelle")

                For j = 8 To 20
                    Cells(iRow, j) = objSheet.Cells(j + 19, 2)
                Next j

                objSheet.Close
                Application.DisplayAlerts = False
                
                End If
            End If
    Next iRow
End Sub