Hallo Zusammen, Danke für die Rückmeldungen

leider ohne Erfolg :(

ich hatte zuerst den unten stehenden Code Makro2 für Werteübertragung benutzt, was auch funktionierte, außer, dass die Dataeien, aus denen ich die Werte nahm, sich nicht shcließen wollten, und deshalb im "Taskmanager"(nicht direkt im Taskmanager aber irgendwo im Hintergrund ) nach der Prozedur noch offen waren. Dies führte dazu, dass ich dann nicht überprüfen konnte, welche Datei gerade in Benutzung oder nicht in Benutzung  ist usw., da alle Dateien "offen" waren...

habe danach den aktuellen  "diesen" Makro1 Code zusammegebastellt...

Vlt. hatte jemand mit sowas zu tun...?

Freundliche Grüße

Axl

der frühere Code Makro2 zur Werteübernahme ohne "Überprüfung" auf aktuallität der geöffneten Daten..

Sub Makro2()
   
    '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 = 7 To 27
                    Cells(iRow, j) = objSheet.Cells(j + 19, 2)

                Next j

'            Set wb = Workbooks.Open(strDateipfad, True)                          <==== !!! Funkt nicht
'           If wb.WriteReservedBy <> Application.UserName Then
'            wb.Close
'                End If

                End If
            End If
    Next iRow
End Sub