Microsoft Office Forum [ www.Office-Fragen.de ] >> READONLY <<

Microsoft Office 2003-2019 => Excel => Thema gestartet von: Cole am Juni 07, 2018, 14:20:16 Nachmittag

Titel: Einen Bereich aus 428 Excel Dateien in einer zusammenfassen
Beitrag von: Cole am Juni 07, 2018, 14:20:16 Nachmittag

Hallo Leute,

ich habe ein kleines Problem, hoffe ihr seid so nett und könnt mir helfen!
In einem Ordner habe ich viele Excel Dateien (428 um genau zu sein), ich benötige aus jeder einzelnen Datei den Bereich A7-C132 in einer einzelnen Excel Datei untereinander (Datei nach Datei) zusammengefasst.

Ich habe schon mehrere Stunden gesucht, jedoch ohne Erfolg. Immer wieder stoße ich auf einzelne Zellen in einer Datei zu verknüpfen oder den Bereich aus einer Datei in eine andere zu kopieren… nichts davon konnte ich anpassen…

Hoffe ihr könnt mir da weiterhelfen!

Vielen Dank & Liebe Grüße,
Cole

Titel: Antw: Einen Bereich aus 428 Excel Dateien in einer zusammenfassen
Beitrag von: gmg-cc am Juni 07, 2018, 19:15:08 Nachmittag

Moin Cole,
das sollte entweder mit VBA machbar sein aber auch ohne Programmierung mit Power Query. Schau mal hier (http://www.excel-ist-sexy.de/kategorie/power-query/daten-zusammenfuehren/) nach, das sollte dir die eine oder andere Idee geben. Ich selbst löse das für mich (und meine Kunden) jetzt so gut wie immer mit Power Query.

Titel: Antw: Einen Bereich aus 428 Excel Dateien in einer zusammenfassen
Beitrag von: Packman am Juni 12, 2018, 15:43:35 Nachmittag

Hallo Cole  :)

Probier mal!

Gruß Packman

Code: [Auswählen]

Sub DateienLesen()
Call EventsOff
    Dim DateiName As String
    DateiName = Dir(OrdnerAuswahl & "\" & "*.xls")
    Do While DateiName <> ""
        If ThisWorkbook.Name <> DateiName Then
            Workbooks.Open Filename:=Dpfad & DateiName
            Workbooks(DateiName).Worksheets(1).Range("A7:C132").Copy
            ThisWorkbook.Worksheets(1).Range("A" & ThisWorkbook.Worksheets(1).Range("A" & Rows.Count).End(xlUp).Row + 1).PasteSpecial Paste:=xlValues, Operation:=xlNone
            Workbooks(DateiName).Close SaveChanges:=False
        End If
        DateiName = Dir
    Loop
    Call EventsOn
End Sub
Function OrdnerAuswahl() As String
    On Error GoTo FehlerRoutine
    Dim AppShell As Object
    Dim BrowseDir As Variant
    Set AppShell = CreateObject("Shell.Application")
    Set BrowseDir = AppShell.BrowseForFolder(0, "Ordner auswählen", &H1000, 17)
    OrdnerAuswahl = BrowseDir.items().Item().Path & "\"
FehlerRoutine:
End Function
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

Titel: Antw: Einen Bereich aus 428 Excel Dateien in einer zusammenfassen
Beitrag von: Packman am Juni 12, 2018, 15:57:38 Nachmittag

Hallo Cole  :)

ops

Diese Zeile korrigieren

Code: [Auswählen]

Workbooks.Open Filename:=Dpfad & DateiName

Dpfad &
kann noch gelöscht werden!

Gruß Packman

Titel: Antw: Einen Bereich aus 428 Excel Dateien in einer zusammenfassen
Beitrag von: Packman am Juni 12, 2018, 20:12:37 Nachmittag

Hallo Cole  :)

Nochmal überarbeitet  :)

Gruß Packman

Code: [Auswählen]

Sub DateienLesen()
    Call EventsOff
    Dim DateiName As String, Dpfad As String
    Dpfad = OrdnerAuswahl
    DateiName = Dir(Dpfad & "*.xls")
    Do While DateiName <> ""
        If ThisWorkbook.Name <> DateiName Then
            Workbooks.Open Filename:=Dpfad & DateiName
            Workbooks(DateiName).Worksheets(1).Range("A7:C132").Copy
            ThisWorkbook.Worksheets(1).Range("A" & ThisWorkbook.Worksheets(1).Range("A" & Rows.Count).End(xlUp).Row + 1).PasteSpecial Paste:=xlValues, Operation:=xlNone
            Workbooks(DateiName).Close SaveChanges:=False
        End If
        DateiName = Dir
    Loop
    Call EventsOn
End Sub
Function OrdnerAuswahl() As String
    On Error GoTo FehlerRoutine
    Dim AppShell As Object
    Dim BrowseDir As Variant
    Set AppShell = CreateObject("Shell.Application")
    Set BrowseDir = AppShell.BrowseForFolder(0, "Ordner auswählen", &H1000, 17)
    OrdnerAuswahl = BrowseDir.items().Item().Path & "\"
FehlerRoutine:
End Function
Public Sub EventsOff()
    With Application
        .DisplayAlerts = False
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With
End Sub
Public Sub EventsOn()
    With Application
        .DisplayAlerts = True
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
    End With
End Sub