Sub gutschriftenZusammen()

'In das Tabellenblatt Dateinamen gehen
Worksheets("Dateinamen").Activate

'Definieren einer String in der, der Dateipfad eingelesen wird
Dim Ordnerpfad As String

'Auswaehlen des Ordners um Dateipfad zu ermitteln

With Application.FileDialog(msoFileDialogFolderPicker)
    .AllowMultiSelect = False
    .Title = "Bitte wähle den Ordner in dem sich die Gutschriften befinden"
    .InitialFileName = ""
    .InitialView = msoFileDialogViewThumbnail
    .ButtonName = "Auswählen"
        
    If .Show = -1 Then
    Ordnerpfad = .SelectedItems(1)
            
    End If
    End With

'Zelle auswaehlen, um Liste einzufügen und Aktivieren des richtigen Tabellenblattes
    Worksheets("Dateinamen").Activate
    Range("A1").Select
    
'Fuegt Liste des ausgewaehlten Ordners ein
    Dim xRow As Long
    Dim xDirect$, xFname$, InitialFoldr$
    InitialFoldr$ = "C:\"
    With Application.FileDialog(msoFileDialogFolderPicker)
    .InitialFileName = Application.DefaultFilePath & "\"
    .Title = "Bitte wähle den Ordner in dem sich die Gutschriften befinden"
    .InitialFileName = InitialFoldr$
    .Show
    If .SelectedItems.Count <> 0 Then
    xDirect$ = .SelectedItems(1) & "\"
    xFname$ = Dir(xDirect$, 7)
    Do While xFname$ <> ""
    ActiveCell.Offset(xRow) = xFname$
    xRow = xRow + 1
    xFname$ = Dir
    Loop
    End If
    End With
    
    
'Es wird die letzte Zeile und die letzte Spalte im Tabellenblatt ermittelt und alles markiert
'Letzte Reihe mit einem Wert
    Dim letzteZeile As Integer
    letzteZeile = ThisWorkbook.Sheets("Dateinamen").Cells(Rows.Count, 1).End(xlUp).Row
'Letzte Spalte mit einem Wert
    Dim letzteSpalte As Integer
    letzteSpalte = ThisWorkbook.Sheets("Dateinamen").Cells(1, Columns.Count).End(xlToLeft).Column
'Markieren
    Range(Cells(1, 1), Cells(letzteZeile, letzteSpalte)).Select

'Vorbereiten der While-Schleife
    Dim DateienZeile As Integer
    DateienZeile = 1
    
    
'Öffnet so viele Dateien wie Dateinamen (Zeilen) in der Liste sind. Anhand der Dateinamen die in der Liste stehen
'SCHLEIFE

    While DateienZeile <> letzteZeile + 1
            
    Worksheets("Dateinamen").Select
            
    Dim DateiName As String
    Dim Dateipfad As String
    DateiName = Cells(DateienZeile, 1).Value
            
    Dateipfad = Ordnerpfad + "\" + DateiName
'   MsgBox Dateipfad
              
'Öffnen der Datei
    Workbooks.Open Dateipfad, Local:=True
    
        
'Ermitteln der letzten Spalte und der letzten Zeile der geoeffneten Datei
        
    Dim letzteZeileSchleife As Integer
    letzteZeileSchleife = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
        
    letzteZeileSchleife = letzteZeileSchleife - 1
        
    Dim letzteSpalteSchleife As Integer
    letzteSpalteSchleife = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
                                    
    
    Dim letzteZeileDatenGutschrift As Integer
    
'Kopieren des gesamten Inhalts der Datei, falls bei Daten Gutschrift kein Inhalt zunfinden ist. Falls Inhalt vorhanden erden die Daten ab Zeile 2 kopiert (ohne Kopfzeile)
    If letzteZeileDatenGutschrift < 1 Then
    Range(Cells(1, 1), Cells(letzteZeileSchleife, letzteSpalteSchleife)).Copy
'########################################
    Workbooks("Beta.xlsm").Activate
    Worksheets("Daten Gutschrift").Select
'########################################
    letzteZeileDatenGutschrift = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
    Range(Cells(1, 1), Cells(1, 1)).Select
    
    Else
    Range(Cells(2, 1), Cells(letzteZeileSchleife, letzteSpalteSchleife)).Copy
'########################################
    Workbooks("Beta.xlsm").Activate
    Worksheets("Daten Gutschrift").Select
'########################################
    letzteZeileDatenGutschrift = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
    Range(Cells(letzteZeileDatenGutschrift + 1, 1), Cells(letzteZeileDatenGutschrift + 1, 1)).Select
    End If
              
              
'Einfügen des kopierten Inhalts. Danach schließen der Datei aus der kopiert wurde.
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
                                    
    Application.CutCopyMode = False
    Workbooks(DateiName).Close SaveChanges:=False
    
    Worksheets("Dateinamen").Select
    DateienZeile = DateienZeile + 1
        
    Wend

End Sub