Zusammenführen von Dateien über Makro

Sub ExcelZusammenFuehren()
Const OrdnerPfad = "C:\Ordner\"
Dim xls_Appl                              ' Excel Programm
Dim xls_Mappe                             ' Excel Arbeitsmappe
Dim xls_Blatt                             ' Excel Tabelle
Dim xls_Mappe1                             ' Excel Arbeitsmappe
Dim xls_Blatt1                             ' Excel Tabelle
Dim fso                                 ' FileSystemObject
Dim fo                                   ' Ordner (Folder)
Dim fi                                    ' Datei (File)
Dim Zeile
Set fso = CreateObject("Scripting.FileSystemObject")
Set fo = fso.GetFolder(OrdnerPfad)
' ***** Excel starten *****
Set xls_Appl = CreateObject("Excel.Application")
xls_Appl.Visible = True            ' Excel sichtbar
Set xls_Mappe = ThisWorkbook ' Tabellenblatt auswählen
Set xls_Blatt = xls_Mappe.Worksheets("Auswertung Tranchenübersicht")
Zeile = 9
For Each fi In fo.Files            ' Alle Dateien im Ordner durchlaufen
If Right(UCase(fi.Name), 3) = "XLS" Then      ' Erkennen der Excel-Dateien
Set xls_Mappe1 = xls_Appl.Workbooks.Open(OrdnerPfad & fi.Name)
Set xls_Blatt1 = xls_Mappe1.Worksheets(1)
' ***** KAM
xls_Blatt1.Activate
xls_Blatt1.Range("KAM").Select    ' Bereich auswählen
xls_Appl.Selection.Copy
xls_Blatt.Activate
xls_Blatt.Range("B" & Zeile).Select    ' Aktive Zelle auswählen
xls_Mappe.ActiveSheet.PasteSpecial (xlPasteValues)
' ***** Kunde
xls_Blatt1.Activate
xls_Blatt1.Range("Kunde").Select    ' Bereich auswählen
xls_Appl.Selection.Copy
xls_Blatt.Activate
xls_Blatt.Range("C" & Zeile).Select    ' Aktive Zelle auswählen
xls_Mappe.ActiveSheet.PasteSpecial (xlPasteValues)
' ***** Jahr
xls_Blatt.Activate
xls_Blatt.Range("D" & Zeile).Select    ' Aktive Zelle auswählen
ActiveCell = xls_Blatt1.Name
' ***** Bestellte Menge
xls_Blatt1.Activate
xls_Blatt1.Range("BM").Select    ' Bereich auswählen
xls_Appl.Selection.Copy
xls_Blatt.Activate
xls_Blatt.Range("E" & Zeile).Select    ' Aktive Zelle auswählen
xls_Mappe.ActiveSheet.PasteSpecial (xlPasteValues)
' ***** Offene Menge
xls_Blatt1.Activate
xls_Blatt1.Range("OM").Select    ' Bereich auswählen
xls_Appl.Selection.Copy
xls_Blatt.Activate
xls_Blatt.Range("F" & Zeile).Select    ' Aktive Zelle auswählen
xls_Mappe.ActiveSheet.PasteSpecial (xlPasteValues)
' ***** Kosten Gesamt
xls_Blatt1.Activate
xls_Blatt1.Range("KG").Select    ' Bereich auswählen
xls_Appl.Selection.Copy
xls_Blatt.Activate
xls_Blatt.Range("M" & Zeile).Select    ' Aktive Zelle auswählen
xls_Mappe.ActiveSheet.PasteSpecial (xlPasteValues)
Zeile = Zeile + 1
xls_Mappe1.Close            ' Eingabe wieder schließen
Set xls_Blatt1 = Nothing        ' Resourcen freigeben
Set xls_Mappe1 = Nothing
End If
Next
xls_Mappe.Save        ' Tabelle speichern
xls_Appl.Quit                         ' Excel beenden
Set fi = Nothing                    ' Resourcen wieder freigeben
Set fo = Nothing
Set fso = Nothing
Set xls_Blatt = Nothing
Set xls_Mappe = Nothing
Set xls_Appl = Nothing
End Sub