Tabellenblätter zusammenführen

[snb]

@Fen

Code:

Sub M_snb()
   If Sheets(1).Name <>"Gesamt" Then Sheets(1).Copy Sheets(1)
   Sheets(1).Name = "Gesamt"
   Sheets(1).UsedRange.Offset(1).ClearContents
End Sub

[Fennek]

Hallo Andrea,

mein Code kopiert ab sheets(2) bis zum letzten sheet. Falle das weiter eingeschränkt werden soll, müssen die Kriterien bekannt sein.

Kannst du den Vorschlag von snb in den Code integrieren? (ein "feihändiger" Versuch)

Code:

Sub andrea1()
If Not Sheets(1).Name = "Gesamt" Then
  Sheets.Add before:=Sheets(1)
  Sheets(1).Name = "Gesamt"
   Sheets(2).Rows(1).Copy Sheets("Gesamt").Cells(1, 1)
Else
  Sheets("Gesamt").Cells.offset(1).Clearcontent
End If
Sheets(2).Rows(1).Copy Sheets("Gesamt").Cells(1, 1)

For i = 2 To Sheets.Count
  lr = Sheets("Gesamt").Cells(Rows.Count, "A").End(xlUp).Row + 1
  Sheets(i).UsedRange.Offset(1).Copy Sheets("Gesamt").Cells(lr, "A")
Next i
End Sub

mfg

(bei copy/paste ist ein zweites Mal "Code" dazugekommen und ich habe nicht gefunden, wie das wieder gelöscht werden kann)

[andrea75w]

Hallo Fennek,

ich habe versucht deinen Code so anzupassen, dass erst ab Register 4 kopiert wird. Hat leider nicht geklappt. :22:
Außerdem müsste der Code noch so erweitert werden, dass ich das Makro mehrmals ausführen kann und sich das Register Gesamt dann immer wieder aktualisiert.

Da ich mich leider (noch) nicht so gut mit VBA auskenne, konnte ich auch den Code von snb nicht integrieren. :20:

Vielen Dank für die tolle Unterstützung!

LG

[Fennek]

Hallo,

wie wäre es damit:

Code:

Sub andrea1()
If Not Sheets(1).Name = "Gesamt" Then
 Sheets.Add before:=Sheets(1)
 Sheets(1).Name = "Gesamt"
  Sheets(2).Rows(1).Copy Sheets("Gesamt").Cells(1, 1)
Else
 Sheets("Gesamt").Cells.offset(1).Clearcontent
End If
Sheets(2).Rows(1).Copy Sheets("Gesamt").Cells(1, 1)

For i = 4 To Sheets.Count 'hier auf 4 erhöhen
 lr = Sheets("Gesamt").Cells(Rows.Count, "A").End(xlUp).Row + 1
 Sheets(i).UsedRange.Offset(1).Copy Sheets("Gesamt").Cells(lr, "A")
Next i
End Sub

Da das Sheets("Gesamt") immer gelöscht wird, sollte der Makro beliebig oft laufen können.

mfg

[snb]

@Fen

Sheets("Gesamt").Cells.offset(1).Clearcontents

[andrea75w]

Hallo zusammen,
ich war jetzt ein paar Tage auf Dienstreise und kann mir eure Vorschläge erst ab morgen anschauen.
Danke und LG

[andrea75w]

Guten Morgen,

leider lässt sich das Makro nicht öfter ausführen. Es erscheint immer eine Fehlermeldung: "Laufzeitfehler 1004"

Außerdem wird die Überschrift aus Register 1 genommen und die Inhalte ab Register 4. Die Überschrift sollte auch aus Register 4 kommen.
Aktuell ist das Makro so aufgebaut, dass eine Kopie inkl. Formeln erstellt wird. Kann man auch "Werte einfügen" ?

Lieben Dank!

[Kuwer]

Hi,

Sheets("Gesamt").Cells.offset(1).Clearcontents

getestet? ;)

Gruß Uwe

[Kuwer]

Hallo Andrea,

Sub Andrea2()

 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.ClearContents

 End If

 Sheets(4).Rows(1).Copy Sheets("Gesamt").Cells(1, 1)

 

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

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

   Sheets(i).UsedRange.Offset(1).Copy

   Sheets("Gesamt").Cells(lr, 1).PasteSpecial Paste:=xlPasteValues

 Next i

End Sub

Gruß Uwe

[andrea75w]

Vielen Dank für die schnelle Antwort. Funktoniert super - bis auf, dass die Register 2x kopiert werden

Würde es auch gehen, dass die Werte in ein bereits vorhandenes Register "Gesamt" kopiert werden was bereits vorformatiert ist? Also immer nur die Inhalte gelöscht werden und wieder eingefügt und nicht das gesamte Blatt?