Zusammenführen von Excel Tabellen

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

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

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

Beliebteste Forumthreads (12 Monate)

Zusammenführen von Excel Tabellen

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread