[Windows 7] Excel Makro: mehrere Dateien zusammenführen

Dieses Thema im Forum "Windows" wurde erstellt von joker.org, 14. Januar 2013 .

  1. 14. Januar 2013
    Excel Makro: mehrere Dateien zusammenführen

    Hallo zusamen,

    ich möchte ein Excel-Makro erstellen, das folgende Aufgabe erfüllt:

    Info: gegeben sei ein Ordner z. B. "Test" mit mehreren Excel-Dokumenten mit Typ .xls
    Die Anzahl der Dokumente ist nicht bekannt bzw. ändert sich immer.
    Das Makro soll nun in einem Excel-Dokument ausgeführt werden und alle Dokumente im Ordner "Test" und alle Arbeitsmapppen der jeweiligen Dokumente (Sheet1, Sheet2, ...) in eine neue Datei zusammenführen.
    Jedes Dokument und Mappe soll in einem neuen Dokument einen Reiter bekommen.

    Das Dokument, in dem das Makro hinterlegt ist, soll unverändert bleiben.
    Im Internet habe ich folgenden Code gefunden, der aber nur zum Teil den Ansprüchen genügt.

    Code:
     Public Sub Daten_mehrerer_Dateien_zusammenfuehren()
    'Code für ein allgemeines Modul
    '********************************
    'Autor: Jürgen Hennekes
    '********************************
    On Error GoTo errExit
    Dim WBQ As Workbook
    Dim WBZ As Workbook
    Dim varDateien As Variant
    Dim lngAnzahl As Long
    Dim lngLastQ As Long
     
    Set WBZ = ActiveWorkbook
    'Altdaten auf Zielblatt löschen
    WBZ.Worksheets(1).Range("A2:IV65536").ClearContents
     
    varDateien = _
    Application.GetOpenFilename("Datei (*.xls),*.xls", False, "Bitte gewünschte Datei(en) markieren", False, True)
     
    With Application
     .ScreenUpdating = False
     .EnableEvents = False
     .Calculation = xlCalculationManual
    End With
     
    For lngAnzahl = LBound(varDateien) To UBound(varDateien)
    Set WBQ = Workbooks.Open(Filename:=varDateien(lngAnzahl))
     lngLastQ = WBQ.Worksheets(1).Range("A65536").End(xlUp).Row
     WBQ.Worksheets(1).Range("A2:Z" & lngLastQ).Copy _
     Destination:=WBZ.Worksheets(1).Range("A" & WBZ.Worksheets(1).Range("A65536").End(xlUp).Row + 1)
    WBQ.Close
    Next
     
    With Application
     .ScreenUpdating = True
     .EnableEvents = True
     .Calculation = xlCalculationAutomatic
    End With
     
    MsgBox "Es wurden " & UBound(varDateien) & " Dateien zusammengefügt.", 64
     
    Exit Sub
     
    errExit:
    With Application
     .ScreenUpdating = True
     .EnableEvents = True
     .Calculation = xlCalculationAutomatic
    End With
     
    If Err.Number = 13 Then
    MsgBox "Es wurde keine Datei ausgewählt"
     Else
    MsgBox "Es ist ein Fehler aufgetreten!" & vbCr _
    & "Fehlernummer: " & Err.Number & vbCr _
    & "Fehlerbeschreibung: " & Err.Description
    End If
     
    End Sub
    
    Ich hoffe, mir kann jemand weiterhelfen.

    Danke und Gruß,
    joker.org

    P.S. bei Fragen oder Unklarheiten bitte melden...
     

  2. Videos zum Thema
    Video Script
Die Seite wird geladen...

Ähnliche Themen mit den Stichworten: Windows Excel Makro

  1. [Windows 7] Makros unter Excel 2007
    KillerKarnickel, 27. Juni 2013 , im Forum: Anwendungssoftware
    Antworten:
    2
    Aufrufe:
    1.381
  2. [Windows 7] Excel lernen :P
    Phame, 12. Mai 2013 , im Forum: Anwendungssoftware
    Antworten:
    1
    Aufrufe:
    926
  3. Antworten:
    1
    Aufrufe:
    2.385
  4. Antworten:
    0
    Aufrufe:
    843
  5. Antworten:
    13
    Aufrufe:
    1.752