Hallo! Da ich auf Grund der Arbeit nicht viel Zeit für einen regen INformationsaustausch habe (sorry dafür), gleich mal ein Programm. Ggf. müsstest du einige Passagen anpassen / ändern. Falls Fragen sind, einfach melden. Das erste Makro (Adresseeintragen) dient für die Hinterlegung der ADressen und das zweite Makro nimmt die Adressen und kopiert die Werte in die Datei. Einfach mal ein leeres Dokument nehmen und beide Makro ausführen - ggf. zwei Schaltflächen. Eines für ADressen eintragen, eines zum Daten übernehmen. Die Daten kommen in Blatt 1. Spalte A die Adressen - ab Spalte C die WErte der Dateien. Die Werte werden angefügt. Wenn es zum "aktualisiseren" dienen soll, müsstest du beim zwiten Makro vorher noch eintragen, dass der Bereich ab Spalte C gelöscht wird - sonst bleiben die alten Daten und die neuen kommen darunter. So das war's erstmal. VG

Option Explicit
Sub Adresseneintragen()
Dim adresse As String
Dim letztezeile As Long
Dim anfrage

ActiveSheet.Cells(1, 1) = "Adressen"

letztezeile = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row

Do
    letztezeile = letztezeile + 1
    adresse = Application.GetOpenFilename
    ActiveSheet.Cells(letztezeile, 1) = adresse
    anfrage = MsgBox("Weitere Adressen eintragen?", vbYesNo)
Loop Until anfrage = vbNo

End Sub

Sub Werte_übernehmen()
Dim gesamtdatei As Object
Dim letztezeile As Long
Dim i As Long
Dim pfad As String
Dim quelle As Object

Application.ScreenUpdating = False

ActiveSheet.Cells(1, 3) = "kopierte Zeilen"

Set gesamtdatei = ActiveWorkbook
letztezeile = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
If letztezeile > 1 Then
    For i = 2 To letztezeile
        pfad = ActiveSheet.Cells(i, 1)
        Workbooks.Open pfad
        Set quelle = ActiveWorkbook
        
        ActiveWorkbook.Sheets("Tabelle1").Range("D40:AZ40").Copy gesamtdatei.Sheets("Tabelle1").Cells(i, 3)
        
        gesamtdatei.Activate
        quelle.Close savechanges:=False
        
        Set quelle = Nothing
    Next i
End If

Set gesamtdatei = Nothing
Application.ScreenUpdating = True

End Sub