Excel Dateien mit VBA und unterschiedlichem Namen in eine Datei

Question

Ich habe da mal wieder ein Spezialfall:

Habe auf dem Desktop eine Ordner liegen in dem 25 Stück Excel Dateien sein. Diese kommen aus meiner Buchhaltung und ich will die Inhalte alle in eine neue Datei zusammenführen.

Alle Dateien beginnen mit Monat-Jahr- XXXXXXXXXXXXXXXX

Vom Aufbau sind alle Dateien ab der Zeile 2 in der Formatierung und dem Aufbau alles gleich.

Kann man sowas über ein Script lösen ?

Answer 1

Hallo Carsten

Da ich wegen Blindheit Office aufgab,

mal ein schuß ins Dunkle.

z.b.

Gruß Nighty

Quelle=Worksheets("Tabelle5")

ändern in=Worksheets(1)

Nanensangabe

Worksheets("Tabelle5")

Indexangabe

Worksheets(1)

 

Ziel=Worksheets("Mastertabelle")

Entsprechend deinen Bedingungen anpassen!

Pfad(String) wäre an zwei Positionen anzupassen

Option Explicit
Sub DateienLesen()
Call EventsOff
Dim DateiName As String
DateiName = Dir("C:\Temp\" & "*.xls")
Do While DateiName <> ""
If ThisWorkbook.Name <> DateiName Then
Workbooks.Open Filename:="C:\Temp\" & DateiName
Workbooks(DateiName).Worksheets("Tabelle5").Range(Cells(2, 1), Cells(Worksheets("Tabelle5").UsedRange.SpecialCells(xlCellTypeLastCell).Row, Worksheets("Tabelle5").UsedRange.SpecialCells(xlCellTypeLastCell).Column)).Copy _
ThisWorkbook.Worksheets("Mastertabelle").Range("A" & ThisWorkbook.Worksheets("Mastertabelle").Range("A" & Rows.Count).End(xlUp).Row + 1)
Workbooks(DateiName).Close
End If
DateiName = Dir
Loop
Call EventsOn
End Sub

Public Sub EventsOff()
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With
End Sub

Public Sub EventsOn()
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
    End With
End Sub