Hallo,

vielleicht hilft dieser Code weiter?

Option Explicit

' Zellenmarker: Inhalte, die mit diesem Zeichen markiert worden sind werden kopiert
Const searchMarker As String = "x"
' Bereich, in dem die Marker gesucht werden
Const rngMarker As String = "A:A"

Private Type StatusWorkbook
    Workbook As Workbook
    opened As Boolean ' True = Workbook wurde vom Programm geöffnet
End Type


Sub Transfer()
    Dim dlg As FileDialog
    Dim SelectItem As Variant
    Dim statusWbk As StatusWorkbook
    Dim wbk As Workbook
    Dim wsh As Worksheet
    Dim rng As Range, lngRow As Long
    Set dlg = Application.FileDialog(msoFileDialogOpen)
    
    With dlg
        .AllowMultiSelect = True
        .InitialFileName = ThisWorkbook.Path & "\"
        .Title = "Wähle alle zu durchsuchende Dateien aus der Liste"
        .ButtonName = "Einlesen"
        .Show
        For Each SelectItem In .SelectedItems
            statusWbk = GetWorkbook(SelectItem)
            Set wbk = statusWbk.Workbook
            If Not wbk Is Nothing Then
                For Each wsh In wbk.Worksheets
                    With wsh.Range(rngMarker)
                        lngRow = 0
                        Set rng = .Find(What:=searchMarker, LookIn:=xlValues, lookat:=xlWhole, MatchCase:=True, SearchDirection:=xlNext)
                        Do Until rng Is Nothing
                            If lngRow > rng.Row Then
                                Exit Do
                            End If
                            lngRow = rng.Row
                            copyRowInNewWorkbook rng
                            Set rng = .FindNext(after:=rng)
                        Loop
                    End With
                Next
                If statusWbk.opened Then
                    If Not Application.CutCopyMode = False Then
                        Application.CutCopyMode = False
                    End If
                    wbk.Close SaveChanges:=False
                End If
            End If
        Next
    End With
End Sub

Function GetWorkbook(ByVal fullName As String) As StatusWorkbook
    Dim wbk As Workbook
    Dim bExists As Boolean
    For Each wbk In Application.Workbooks
        If wbk.fullName = fullName Then
            bExists = True
            Exit For
        End If
    Next
    If Not bExists Then
        Set wbk = Application.Workbooks.Open(fullName)
    End If
    Set GetWorkbook.Workbook = wbk
    GetWorkbook.opened = Not bExists
End Function

Sub copyRowInNewWorkbook(rng As Range)
    Static wbk As Workbook
    Static lngRow As Long
    If wbk Is Nothing Then
        Set wbk = Application.Workbooks.Add
    End If
    rng.EntireRow.Copy
    lngRow = lngRow + 1
    wbk.Activate
    With wbk.Worksheets(1)
        .Activate
        With .Rows(lngRow).Cells(1, 1)
            .Select
            ActiveSheet.Paste
        End With
    End With
End Sub

Mit dem Befehl Transfer wird das Programm gestartet.

Nach dem Starten wird ein Dialog angezeigt, in dem der Anwender aufgefordert wird, die zu durchsuchtenden Arbeitsmappen auszuwählen.

Nach der Auswahl werden nacheinander alle Arbeitsmappen geöffnet und sämtliche Tabellen nach der Markierung durchsucht. Bei einem Treffer wird die ganze Zeile via Zwischenablage in eine neu erstellte Arbeitsmappe kopiert.

Die Suche nach dem Marker beschränkt sich auf die Spalte A (kann mit der Variable rngMarker verändert werden).

Der benutzerdefinierte Typ StatusWorkbook wird gebraucht, um später eine zuvor geöffnete Arbeitsmappe nach dem Durchsuchen wieder schließen zu können. Alle vom Programm geöffnete Arbeitsmappen werden von diesem ohne zu speichern wieder geschlossen.

Programm wurde getestet mit Excel 2013.

LG, BigBen