Tabellenblätter zusammenführen

[WeisserWolf611]

Hallo,

ich stehe mal wieder vor einem größeren Problem:

Ich hab eine Datei die besteht aus Deckblatt, Inhaltsverzeichnis und dann unterschiedliche viele Seiten (die sind aber alle gleich aufgebaut und bestehen aus einem DIN-Zeichenrahmen).

Ich möchte jetzt über ein Makro folgendes realisieren:

Ich möchte ab der dritten Seite bis zum Ende der Mappe aus jedem Sheet einen gewissen Bereich (C9-DB77) in einer neuen Tabelle zusammenführen.
Da sind zwar auch leere Zeílen bei, aber die kann ich über normale Filter ausblenden.

Das Ausgabe-Sheet soll nicht erstellt werden, sondern das vorhandene ("Komplette Liste", ab Zelle C9) gefüllt werden.

Im Prinzip ist es nur copy&paste, aber ich kriegs einfach nicht auf die Kette.
Jemand von euch einen guten Tip oder sogar eine Lösung parat?

Vielen Dank schonmal.
Gruß
Wolf

[Rabe]

Hi Wolf,

Jemand von euch einen guten Tip oder sogar eine Lösung parat?

soll das ein Mal oder immer wieder gemacht werden?

Bei ein Mal würde ich es manuell machen.


Ansonsten in ein allgemeines Modul ein Makro (ungetestet):

Sub kopieren()
   Dim i As Long
   Dim loLetzte As Long
   
   With ThisWorkbook
      For i = 3 To Sheets.Count
         loLetzte = .Sheets("Komplette Liste").Cells(Rows.Count, 3).End(xlUp).Row           ' letzte belegte in Spalte C (3) 
         .Sheets(i).Range("C9:DB77").Copy .Sheets("Komplette Liste").Range("C" & loLetzte)
      Next i
   End With
End Sub

Wobei das nicht sein kann, denn dann wäre das "komplette Liste" auch eines der zu kopierenden Blätter.

[WeisserWolf611]

Vielen Dank für die schnelle Antwort.
Also das ganze muss nur einmal ausgeführt werden, bzw. ein zweites Mal bei Bedarf, aber da kann er die vorherige Tabelle überschreiben...

Hier kommt es zu einer Fehlermeldung:

Code:

.Sheets(i).Range("C9:DB77").Copy .Sheets("Komplette Liste").Range("C" & loLetzte)

"Dies ist bei verbundenen Zellen nicht möglich."

ich mag die verbundenen Zellen auch nicht, aber die Tabelle ist kundenseitig vorgegeben. :(

Gruß
Wolf

[Rabe]

Hi Wolf,

"Dies ist bei verbundenen Zellen nicht möglich."

ich mag die verbundenen Zellen auch nicht, aber die Tabelle ist kundenseitig vorgegeben. :(

Wo sind verbundene Zellen?

Was ist vorgegeben: das Layout (Optik) oder wirklich "verbundene Zellen"?
Ein optisches Zentrieren über eine Zellauswahl geht auch ohne verbundene Zellen.

Im zweiten Fall ist eine Hilfe mMn ohne eine hochgeladene Datei nicht einfach.

[WeisserWolf611]

Ich hab mal ein Beispiel angehängt.

Die Seitenzahlen habe ich schon "automatisiert", deshalb muss die komplette Liste auch ans Ende der Datei.
Die Anzahl der Listen ist variabel, jetzt sind es nur 2, es können aber auch 20 und mehr sein.

Gruß
Wolf

[Rabe]

Hi Wolf,

Die Seitenzahlen habe ich schon "automatisiert", deshalb muss die komplette Liste auch ans Ende der Datei.

trotzdem könntest Du Dir die "Komplette Liste" an die dritte Stelle holen und im Makro dann eben mit 4 anfangen statt mit 3. Oder Du schreibst so:
For i = 3 To Sheets.Count - 1

Aber insgesamt bluten mir die Augen mit den vielen verbundenen Spalten und Zeilen.
Das Layout müßte auch ohne diese verbundenen Zellen im Datenbereich möglich sein.

Das ist mir zu kompliziert, vor allem, weil da ja auch noch unendlich viele Leerzeilen zwischen den Daten drin sind.
Bei dem Layout bin ich raus.

[WeisserWolf611]

Schön finde ich das auch nicht, kann ich nichts dran ändern.
Die Leerzeilen sind vollkommen irreleavant und sollen mitkopiert werden.
Von jeder Seite der gleiche Bereich nur am Stück untereinandern.

Simple Aufgabe eigentlich, aber scheint doch durch die Formatierung sehr schwierig zu sein...
Ich schlaf mal ne Nacht drüber, vielleicht fällt mir doch noch selbst was ein...

Vielen Dank für deine Bemühungen!

Gruß
Wolf

[atilla]

Hallo,

das geht hier auch mit verbundenen zellen, da die Tabellen gleich aufgebaut sind.
Unter der Vorgabe, dass die zu kopierenden Tabellennamen mit "Liste" beginnen,
sollte unten stehender Code Deinen Wünschen entsprechen:

Code:

Sub kopieren()
 Dim wks As Worksheet
 Dim lngZ As Long
 
 With Sheets("Komplette Liste")
   For Each wks In ActiveWorkbook.Worksheets
     If LCase(Left(wks.Name, 5)) = "liste" Then
       lngZ = Application.Max(9, .Cells(.Rows.Count, 3).End(xlUp).Row +2)
       wks.Range("C9:DT78").SpecialCells(xlCellTypeConstants, 23).Copy .Range("C" & lngZ)
     End If
   Next wks
 End With
End Sub

[WeisserWolf611]

Hallo,

erstmal vielen Dank, das funktioniert noch besser als ich es gehofft hatte, nur Zeilen mit Inhalt wird kopiert, das is sehr komfortabel :)

Unter der Vorgabe, dass die zu kopierenden Tabellennamen mit "Liste" beginnen,
sollte unten stehender Code Deinen Wünschen entsprechen:

Nunja das ist leider nicht ganz so... die Seiten heißen alle unterschiedlich :(
Könnte man sagen: Generiere diese Liste aus allen markierten sheets?

Gruß
Wolf


edit:
Ich hab jetzt einfach ein paar reale Einträge in die Datei gehämmert. Das Makro lief vorher wunderbar, jetzt hängt es hier und ich bekomme folgende Meldung:

wks.Range("C9:DT78").SpecialCells(xlCellTypeConstants, 23).Copy .Range("C" & lngZ)

Diese Aktion funktioniert nicht bei einer Mehrfachauswahl.
Ich verstehe allerdings nicht wo das Problem liegt :s
Was in den Zellen steht ist doch vollkommen egal, oder etwa nicht?

[atilla]

Hallo Wolf,

teste mal folgenden Code:

Code:

Sub kopieren()
Dim i As Long
Dim lngZ As Long
Dim varTab

varTab = Array("Liste", "Liste 2", "Liste 3") 'hier die Tabellen auflisten, die kopiert werden sollen
With Sheets("Komplette Liste")
  For i = LBound(varTab) To UBound(varTab)
     lngZ = Application.Max(9, .Cells(.Rows.Count, 3).End(xlUp).Row + 2)
     Sheets(varTab(i)).Range("C9:DT78").SpecialCells(xlCellTypeConstants, 23).Copy .Range("C" & lngZ)
  Next i
End With
End Sub

De Tabellen, die kopiert werden sollen im Code in der Zeile mit dem Kommentar auflisten.

Wenn der zueltzt erwähnte Fehler erneut auftauchen sollte, dann stell bitte eine Beipielmappe ein, und beschreib, wann genau der Fehler auftaucht.