Alle die es Interessiert, der Code scheint zu funktionieren, ich warte jedoch noch auf eine Antwort von Raimond:

Option Explicit
Dim wbQuelle As Workbook, wBZiel As Workbook
Dim wsQuelle As Worksheet, wsZiel As Worksheet
Dim lstQZeile As Integer, lstZZeile As Integer

Sub Datei_Auslesen()
Dim iCount As Integer, i As Integer, strDatei As Variant
Dim strName As String, lstQcolumn As Integer
Dim iQrow, iZrow As Integer, iZcolumn As Integer, iQcolumn As Integer

Set wBZiel = ThisWorkbook

For iCount = 1 To Workbooks.Count
    If InStr(Workbooks(iCount).Name, "Datei-Y") Then
        Set wbQuelle = Workbooks(iCount)
        Set wsQuelle = wbQuelle.Sheets(1)
    End If
Next iCount

If wbQuelle Is Nothing Then
    strDatei = Application.GetOpenFilename
    If strDatei <> False Then
        Set wbQuelle = Workbooks.Open(strDatei)
        Set wsQuelle = wbQuelle.Sheets(1)
    Else:
        GoTo Ende
    End If
    
End If

Windows(wBZiel.Name).Activate

lstQZeile = wsQuelle.Cells(20000, 2).End(xlUp).Row
lstQcolumn = wsQuelle.Cells(5, 256).End(xlToLeft).Column - 1
For i = 4 To lstQcolumn
        If wsQuelle.Cells(5, i) <> "" Then
            strName = wsQuelle.Cells(5, i)
            Set wsZiel = ThisWorkbook.Worksheets(strName)
            lstZZeile = wsZiel.Cells(20000, 1).End(xlUp).Row
        End If
        
        For iQrow = 7 To lstQZeile
            For iZrow = 5 To lstZZeile
                If wsQuelle.Cells(iQrow, 2) = wsZiel.Cells(iZrow, 1) Then
                    iQcolumn = i
                    Do While iQcolumn < lstQcolumn
                        If wsQuelle.Cells(5, iQcolumn + 1) <> "" Then Exit Do
                            For iZcolumn = 3 To 26
                                If InStr(wsZiel.Cells(1, iZcolumn), wsQuelle.Cells(6, iQcolumn)) Then
                                    wsZiel.Cells(iZrow, iZcolumn) = wsQuelle.Cells(iQrow, iQcolumn)
                                End If
                            Next iZcolumn
                        iQcolumn = iQcolumn + 1
                    Loop
                  End If
            Next iZrow
        Next iQrow
Next i


Set wBZiel = Nothing
Set wsZiel = Nothing
Set wbQuelle = Nothing
Set wsQuelle = Nothing

Exit Sub

Ende:

MsgBox "Es wurde keine Datei ausgewählt, Programm wird abgebrochen!", vbExclamation
Set wBZiel = Nothing
Set wsZiel = Nothing
Set wbQuelle = Nothing
Set wsQuelle = Nothing

End Sub