Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

Zusammenführen von Excel Tabellen

Betrifft: Zusammenführen von Excel Tabellen von: Andreas
Geschrieben am: 31.08.2014 12:21:41

Hallo,

ich bin gerade auf der Suche nach einer Lösung für folgendes Problem.

Ich habe 35 Exceltabellen. Alle haben die gleichen Spalten aber unterschiedliche Datensätze. Ich würde diese 35 Tabellen gerne in einer Zusammenführen und dort dann filtern können. Bei meiner Suche bin ich auf folgendes Makro gestoßen.


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

Habe es auch hinbekommen es auszuführen. (Ich bin Makro/VBA kompletter Anfänger) Leider führt er zuverlässig nur die ersten 11 Dateien aus danach nur noch vereinzelt. Wo liegt mein Fehler bzw. der Fehler in diesem Code? Wie gesagt, ich kann an dem Code rein gar nichts herauslesen. Habe den nur über eine Google-Suche gefunden.

mfg Andi

  

Betrifft: AW: Zusammenführen von Excel Tabellen von: WalterK
Geschrieben am: 31.08.2014 15:01:35

Hallo Andi,

ich habe im Internet einmal diesen Code gefunden, funktioniert einwandfrei.

Es werden alle Dateien eines Ordners in diese Masterdatei mit dem Code in 1 Blatt untereinanderkopiert.
Die Masterdatei muss auch in diesem Ordner gespeichert sein.

Option Explicit
Sub zusammenfuegen()
    Dim strDateiname As String
    Dim wksZiel As Worksheet, wkbQuelle As Workbook, wksQuelle As Worksheet
    Dim loLetzte1 As Long
    Dim loLetzte2 As Long
    Dim inLetzte As Integer
    Application.ScreenUpdating = False
    strDateiname = Dir(ThisWorkbook.Path & "\*.xls")
    Set wksZiel = ThisWorkbook.Worksheets("Tabelle1")
    Do While strDateiname <> ""
        If strDateiname <> ThisWorkbook.Name Then
            Set wkbQuelle = Workbooks.Open(Filename:=ThisWorkbook.Path & "\" & strDateiname)
            Set wksQuelle = ActiveSheet 'ggf. = wkbQuelle.Worksheets(1)
            
            loLetzte1 = wksZiel.UsedRange.SpecialCells(xlCellTypeLastCell).Row
            With wksQuelle
              loLetzte2 = .UsedRange.SpecialCells(xlCellTypeLastCell).Row
              inLetzte = .UsedRange.SpecialCells(xlCellTypeLastCell).Column
              .Range(.Cells(3, 1), .Cells(loLetzte2, inLetzte)).Copy _
                    Destination:=wksZiel.Cells(loLetzte1 + 1, 1)
            End With
            
            wkbQuelle.Close True
        End If
        strDateiname = Dir
    Loop
    Set wkbQuelle = Nothing: Set wksQuelle = Nothing: Set wksZiel = Nothing
    Application.ScreenUpdating = True
End Sub
Servus, Walter


  

Betrifft: AW: Zusammenführen von Excel Tabellen von: Andreas
Geschrieben am: 31.08.2014 18:12:52

Perfekt. Der klappt super. Vielen herzlichen Dank.


 

Beiträge aus den Excel-Beispielen zum Thema "Zusammenführen von Excel Tabellen"