Hi Stefan,

versuche es mal mit diesem Code, der ab Zeile 2 den gesamten benutzten Bereich jeder Tabelle kopiert

Sub zusammenfuegen()
    Dim strDateiname As String
    Dim loLetzte1 As Long
    Dim loLetzte2 As Long
    Dim inLetzte As Integer
    Application.ScreenUpdating = False
    strDateiname = Dir(ThisWorkbook.Path & "\*.xls")
    With ThisWorkbook.Worksheets("Tabelle1")
        Do While strDateiname <> ""
            If strDateiname <> ThisWorkbook.Name Then
                Workbooks.Open Filename:=ThisWorkbook.Path & "\" & strDateiname
                loLetzte1 = .UsedRange.SpecialCells(xlCellTypeLastCell).Row
                loLetzte2 = ActiveWorkbook.ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
                inLetzte = ActiveWorkbook.ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Column
                ActiveWorkbook.ActiveSheet.Range(Cells(3, 1), Cells(loLetzte2, inLetzte)).Copy Destination:=.Cells(loLetzte1 + 1, 1)
                ActiveWorkbook.Close True
            End If
            strDateiname = Dir
        Loop
    End With
    Application.ScreenUpdating = True
End Sub

Es wird davon ausgegangen, dass sich die Arbeitsmappe mit dem Code im selben Verzeichnis wie die auszulesenden Arbeitsmappen befindet. Lässt sich natürlich auch z.B. auf einen fest vorgegebenen Pfad ändern.

Bis später,
Karin

hi Beverly :-)

na ich dann auch noch :-))

lady first heisst es ja :-)))

gruss nighty

liest aus geschlossenen dateien

vom zielverzeichnis ausgehend werden alle sheets von allen gefundenen dateien mit dem angegebenen bereich ausgelesen

pfad natuerlich entsprechen anzupassen

Option Explicit
Sub makro01()
Dim tabellen As Integer
Dim Dateien As Integer
Dim DateiName As String
Dim zelle As Range
With Application.FileSearch
.NewSearch
.LookIn = "C:\test3"
.SearchSubFolders = False
.Filename = "*.*"
If .Execute() > 0 Then
Cells(1, 1) = ""
For Dateien = 1 To .FoundFiles.Count
For tabellen = 1 To Sheets.Count
For Each zelle In Range("A1,A2")
Cells(1, 1) = Cells(1, 1) + ExecuteExcel4Macro("'C:\test3\" & "[" & _
Mid(.FoundFiles(Dateien), Len(.LookIn) + 2, Len(.FoundFiles(Dateien))) & "]" & _
Sheets(tabellen).Name & "'!" & zelle.Address(, , xlR1C1))
Next zelle
Next tabellen
Next Dateien
End If
End With
End Sub

Hi nighty,

Stefan schreibt, dass die Zeilenanzahl unterschiedlich sein kann. Bei deinem Code wird jedoch von Anfang an vorausgesetzt, dass eine festgelegte Anzahl an Zeilen übernommen wird. Ich habe aus Stefans Frage auch nicht unbedingt entnommen, dass er die Ergebnisse summieren möchte. Ist es da nicht sinnvoller, erst einmal alle Daten aus den anderen Mappen in eine zu bringen und diese dann hinterher entsprechend den Erfordernissen zu bearbeiten? Gut, mit meinem Code werden die Arbeitsmappen im Hintergrund geöffnet und anschließend wieder geschlossen, aber davon bekommt der User ja nichts mit. Und dann ist der Code wesentlich schneller, weil ja nicht jede Zeile einzeln ausgelesen wird, sondern der komplette benutzte Bereich auf einen Ritt kopiert wird. Ich habe den benutzten Bereich verwendet, da mir nicht ganz klar ist, was Stefan mit "M Spalten" gemeint hat. Wenn SpalteM gemeint ist, lässt sich der Code ja problemlos anpassen.

Unere Codes berücksichtigen allerdings beide nicht, dass Stefan alle Zeilen ohne Leerzeilen übernehmen will. Aber dazu könnte man nach dem Übertragen noch diesen Code ausführen lassen, mit dem dann in der zusammenfassenden Tabelle alle Leerzeilen gelöscht werden

Sub Leerzeilen_loeschen()
    ' alle Leerzeilen löschen, dabei alle Leerzeilen auf eine Variable schreiben und alles mit einmal löschen
    ' Code von Hajo Ziplies
    Dim LoI As Long
    Dim RaZeile As Range
    For LoI = 1 To ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
        If Application.WorksheetFunction.CountA(Rows(LoI)) <> ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Column Then
            If Rows(LoI).SpecialCells(xlCellTypeBlanks).Count = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Column Then
                If RaZeile Is Nothing Then
                    Set RaZeile = Rows(LoI)
                Else
                    Set RaZeile = Union(RaZeile, Rows(LoI))
                End If
            End If
        End If
    Next LoI
    If Not RaZeile Is Nothing Then RaZeile.Delete  ' hier werden alle Leerzeilen auf einmal gelöscht
    Set RaZeile = Nothing
End Sub

Bis später,
Karin

Hallo zusammen,

erst mal vielen Dank für die Hilfe, in der Tat haben wir momentan nur die Spalten A-M aber wenn der Code so flexibel ist, dass er das automatisch mitbekommt, um so besser .-)

Aufsummieren sollte Excel da um Gottes willen bloß nix, sondern einfach nur die Zeilen untereinander kopieren, wir werden da später entsprechende Filter darüberlegen, das reicht dann schon aus :-)

Werde das Ganze morgen mal ausprobieren, komme heute nicht dazu, da ich nen Server migrieren muss...

Grüsse

Stefan

hi Beverly :-)

stimmt auf jedefall, ich benutz den code auch nur um kleine datenmengen zu holen :-))

gruss nighty