Hallo ich bins noch mal,

habe mitlerweile folgenden Code

Sub Dateien_Auf_Speichern_Zu()
Dim Datei As String
Dim Arbeitsmappe As String
Dim PFAD As String
Dim rFind As Range

PFAD = InputBox("Geben Sie bitte den Ordner an der durchsucht werden soll")
Datei = Dir(PFAD & "*.xls")
Application.ScreenUpdating = False
Application.DisplayAlerts = False
  Do While Datei <> ""
    Application.Workbooks.Open Datei
    
    Set rFind = Cells.Find(What:="Gesamt-UMSATZ", After:=Cells(1, 6), LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
    rFind.Columns("e:n").Select
    Selection.Copy
    Sheets.Add
    ActiveSheet.Paste
        
    ActiveWorkbook.Close True
    Datei = Dir()
  Loop
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Allerdings passiert beim ausführen nichts kann mir jemand sagen wieso`?

Gruß Rene