Tabellenblätter zusammenführen

[Kuwer]

Hallo Andrea,

Sub Andrea3()

 Dim i As Long, lr As Long

 If Not Sheets(1).Name = "Gesamt" Then

   Sheets.Add before:=Sheets(1)

   Sheets(1).Name = "Gesamt"

 Else

    Sheets("Gesamt").Cells = ""

 End If

 

 Sheets("Gesamt").Rows(1).Value = Sheets(4).Rows(1).Value

 For i = 4 To Sheets.Count 'hier auf 4 erhöhen

   lr = Sheets("Gesamt").Cells(Rows.Count, 1).End(xlUp).Row + 1

   With Sheets(i).UsedRange

     Sheets("Gesamt").Cells(lr, 1).Resize(.Rows.Count - 1, .Columns.Count).Value = _

       .Resize(.Rows.Count - 1).Offset(1).Value

   End With

 Next i

End Sub

Das die Register 2x kopiert werden, muss eine andere Ursache haben.

Gruß Uwe

[andrea75w]

:19: Super!!! Danke! Danke! Danke! es funktioniert

Jetzt brauche ich nur noch eine Lösung für Schritt 2.
Das erzeugte Blatt "Gesamt" gibt es jetzt in 7 Dateien. Diese 7 Blätter möchte ich jetzt in einer neuen Gesamtdatei zusammenführen. So dass alle 7 Blätter in einem Blatt zusammengeführt sind.

[schauan]

Hallo Andrea,

letzte Aufgabe schon geschafft? Ansonsten wäre die Frage, wie das aussehen soll. Alle Daten zusammenführen oder nur bestimmte Spalten / Zeilen oder Ergebnisse? Spielt die Reihenfolge eine Rolle? Willst Du pro Datei gleich große Bereiche verwenden? Wo stehen die Daten? ...
Du könntest auch mal das Einfügen einer Datei in die neue Gesamtdatei mit dem Makrorekorder aufzeichnen und den Code posten, wir passen ihn dann an.

[andrea75w]

Hallo schauan,

leider noch nicht geschafft...

Die 7 Dateien liegen in einem Ordner und die Gesamtdatei kann im gleichen Ordner gespeichert werden. Die 7 Dateien sind von der Form, Überschriften etc. identisch. Nur die Inhalte sind natürlich unterschiedlich. In jedem der 7 Dateien gibt ein Register "Gesamt" welche in der Gesamtdatei in einem Register zusammengefasst werden sollen - also untereinander kopiert werden. Die Reihenfolge spielt dabei keine Rolle. Da die Dateien aber leben, verändert sich natürlich immer die Zeile wo die nächste Datei eingefügt wird. Ich versuche das mal mit dem Makrorekorder. Wusste nicht, dass der auch Aktionen Dateiübergreifend aufzeichnet!?

LG Andrea

[andrea75w]

Sub GesamtGesamt()
'
' GesamtGesamt Makro
'
'
    Windows("Test-WJH-Statistik_1.xlsm").Activate
    ActiveWindow.SmallScroll Down:=-21
    Range("A2:A7").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range("A2:AM7").Select
    Selection.Copy
    ActiveWindow.ActivateNext
    ActiveSheet.Paste
    Range("A8").Select
    Windows("Test-WJH-Statistik_2.xlsm").Activate
    Range("A2:A7").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range("A2:AM7").Select
    Application.CutCopyMode = False
    Selection.Copy
    ActiveWindow.ActivateNext
    ActiveSheet.Paste
    Range("A14").Select
    Windows("Test-WJH-Statistik_3.xlsm").Activate
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range("A2:AM7").Select
    Application.CutCopyMode = False
    Selection.Copy
    ActiveWindow.ActivateNext
    ActiveSheet.Paste
    ActiveWindow.ActivateNext
    Windows("Test-WJH-Statistik_4.xlsm").Activate
    Range("A2:A7").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range("A2:AM7").Select
    Application.CutCopyMode = False
    Selection.Copy
    ActiveWindow.ActivateNext
    ActiveWindow.ActivateNext
    ActiveWindow.ActivateNext
    ActiveWindow.ActivateNext
    ActiveWindow.ActivateNext
    ActiveWindow.ActivateNext
    ActiveWindow.ActivateNext
    Range("A20").Select
    ActiveSheet.Paste
    Windows("Test-WJH-Statistik_5.xlsm").Activate
    Range("A2:AM7").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Test-WJH-Statistik_Gesamt.xlsm").Activate
    Range("A26").Select
    ActiveSheet.Paste
    Windows("Test-WJH-Statistik_6.xlsm").Activate
    Range("A2:AM7").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Test-WJH-Statistik_Gesamt.xlsm").Activate
    ActiveWindow.SmallScroll Down:=15
    Range("A32").Select
    ActiveSheet.Paste
    Range("A38").Select
    Windows("Test-WJH-Statistik_7.xlsm").Activate
    Range("A2:AM7").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Test-WJH-Statistik_Gesamt.xlsm").Activate
    ActiveSheet.Paste
    Range("A2").Select
End Sub

[snb]

Alle Vorschläge um sonst

[andrea75w]

hallo snb,

NEIN!!!!! der erste teil funktioniert super. für den zweiten teil hatte ich noch keine vorschläge...

[schauan]

Hallo Andrea,

habe gerade gesehen, dass da noch was offen ist

Also, Du könntest die erste freie Zelle/Zeile des aktiven Blattes so feststellen:

lFreeCell=Cells(Rows.Count, 1).End(xlUp).Row+1

Das setzt voraus, dass in Spalte A auch ein Eintrag in der letzten belegten Zelle ist.

Statt den vielen ActiveWindow.ActivateNext kannst Du auch gleich das nötige Fenster mit Windows("...").Activate aktivieren, hast Du ja auch ab und zu verwendet.

Zusammenfassen kannst Du auch so etwas
Range("A2:AM7").Select
Application.CutCopyMode = False
Selection.Copy
zu
Range("A2:AM7").Copy

Diesen Bereich hast DU ja eventuell mit der Cursorbewegung markiert?
Range("A2:A7").Select
Range(Selection, Selection.End(xlToRight)).Select
Range("A2:AM7").Select
Falls die Zeile 7 keine feste Zeile ist, könnte man das flexibel auch so tun. Ist zwar Select, aber erst mal das gleiche Strickmuster:
Range("A2").Select 'oder wie gehabt "A2:A7"
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select

Die Zeilen mit ScrollDown kannst Du auch löschen.