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
: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.
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.
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
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
hallo snb,
NEIN!!!!! der erste teil funktioniert super. für den zweiten teil hatte ich noch keine vorschläge...
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.