Sub gutschriftenZusammen()
Worksheets("Dateinamen").Activate
Dim Ordnerpfad As String
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
Worksheets("Dateinamen").Activate
Range("A1").Select
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
Dim letzteZeile As Integer
letzteZeile = ThisWorkbook.Sheets("Dateinamen").Cells(Rows.Count, 1).End(xlUp).Row
Dim letzteSpalte As Integer
letzteSpalte = ThisWorkbook.Sheets("Dateinamen").Cells(1, Columns.Count).End(xlToLeft).Column
Range(Cells(1, 1), Cells(letzteZeile, letzteSpalte)).Select
Dim DateienZeile As Integer
DateienZeile = 1
While DateienZeile <> letzteZeile + 1
Worksheets("Dateinamen").Select
Dim DateiName As String
Dim Dateipfad As String
DateiName = Cells(DateienZeile, 1).Value
Dateipfad = Ordnerpfad + "\" + DateiName
Workbooks.Open Dateipfad, Local:=True
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
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
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