Mehrer Tabellenblätter in eine neue Tabelle kopieren

Question

Hallo zusammen,

ich habe eine Tabelle bestehend aus ca. 25 Tabellenblättern.

20 davon möchte ich gerne über ein Makro untereinander in ein neues Tabellenblatt kopieren (Aufbau ist identisch).

Nur haben die Tabellenblätter einen Haken, sie erzeugen ihren Namen nämlich selber (auch über ein Makro).

Kann ich das dann noch über ein Makro lösen? Findet das "KopierMakro" die TAbellen noch wenn sich monatlich die Registernamen ändern?

Gruß Lefty

Answer 1

Hallo Lefty,

wie soll das Makro wissen, welche Tabellenblätter es kopieren soll?

Du kannst Tabellenblätter natürlich auch ohne den Namen ansprechen:

Sub beispiel()

For blatt = 1 To ThisWorkbook.Worksheets.Count
Worksheets(blatt).Cells(1, 1) = Worksheets(blatt).Name
Next blatt

End Sub

Nur hilft dir das nicht weiter, da ja nicht alle Arbeitsblätter in der Mappe kopiert werden sollen.

Nur haben die Tabellenblätter einen Haken, sie erzeugen ihren Namen nämlich selber (auch über ein Makro).

Hast du Einfluss auf dieses Makro? Dann wäre es am einfachsten im Blatt irgendwo (z.B. in einer ausgeblendeten Zelle) einen Marker zu setzen, dass aus diesem Blatt Daten kopiert werden sollen.

Falls alle zu kopierenden Blätter immer mit der selben Buchstaben- / Zahlenkombination anfangen könnte man ggf. über den Namen die Auswahl treffen.

Ohne weitere Einzelheiten ist es schwer, konkrete Hilfe zu geben.

Gruß

M.O.

Answer 2

Hallo,

schonmal danke für die Antwort.

Folgendes Makro ist bei den entsprechenden Tabellenblättern hinterlegt um den Namen automatisch zu erzeugen:

Private Sub Worksheet_Change(ByVal Target As Range)
'Code in das entsprechende Tabellenblatt!
If Len(Range("D2")) < 32 And Range("D2") <> "" Then
ActiveSheet.Name = Range("D2").Value
End If
End Sub

Der Name der Tabellenblätter ist immer ein Datum.

Falls alle zu kopierenden Blätter immer mit der selben Buchstaben- / Zahlenkombination anfangen könnte man ggf. über den Namen die Auswahl treffen.

Ich könnte bei den Blattnamen immer noch das Wort "Erhebung" an den Anfang setzen z.B. Erhebung-27.12.2013.

Würde das helfen?

Gruß Lefty

Answer 3

Hallo Lefty,

das würde Helfen.
Dein Kopiermakro könnte dann z.B. so aussehen:

Sub beispiel()

Dim blatt, zaehler As Long

For blatt = 1 To ThisWorkbook.Worksheets.Count

If Left(ThisWorkbook.Worksheets(blatt).Name, 8) = "Erhebung" Then
'hier dann die Kopierroutine
zaehler = zaehler + 1
ThisWorkbook.Worksheets("Tabelle1").Cells(1 + zaehler, 1) = ThisWorkbook.Worksheets(blatt).Range("A1")
End If

Next blatt

End Sub

Gruß

M.O.

Answer 4

Wow,

das ging fix, DANKE....

Ähhm, hast du evtl. auch noch eine Idee für die Kopierroutine???

Gruß Lefty

Answer 5

Achja,

und starten soll er mit den Tabellen in Zelle A13

:)

Answer 6

Oh man,

heute hab ich´s aber....SORRY

und die Tabellen die kopiert werden starten in Zelle A9

Answer 7

Hallo Lefty,

was soll den Kopiert werden?

In den Erhebungsblättern von Zelle A9 jeweils die ganze Zeile bis zum Ende?
Wie heißt die Zieltabelle?
Und dort sollen ab A13 die Daten eingefügt werden?

Eine genauere Erklärung wäre schon sehr hilfreich.

Gruß

M.O.

Answer 8

was soll den Kopiert werden?

In den Erhebungsblättern soll ab Zelle A9 die ganze Zeile kopiertwerden.
Ist es entscheidend wo die Tabellen zuende sind? Oder erkennt das Makro das?

Die Zieltabelle nennt sich "HILFSTABELLE" und dort soll ab Zelle A13 eingefügt werden.

Da die Datei monatlich aktualiert wird besteht da noch die möglichkeit alle "alten" Daten in der "Hilfstabelle" zu löschen???

Gruß Lefty

Answer 9

Hallo Lefty,

probiere mal das folgende Makro aus (den Namen des Zielblattes musst du noch ggf. anpassen):

Sub kopieren()

Dim blatt, lzziel, lzspalte, lzquelle As Long

'Daten in Hilfstabelle löschen
'letzte Zeile in Hilfstabelle ermitteln - ggf. Schreibweise des Namens anpassen
lzziel = ThisWorkbook.Worksheets("Hilfstabelle").UsedRange.SpecialCells(xlCellTypeLastCell).Row
lzspalte = ThisWorkbook.Worksheets("Hilfstabelle").UsedRange.SpecialCells(xlCellTypeLastCell).Column
'Bereich löschen
ThisWorkbook.Worksheets("Hilfstabelle").Range(Cells(13, 1), Cells(lzziel, lzspalte)).ClearContents

'Kopieren
For blatt = 1 To ThisWorkbook.Worksheets.Count

If Left(ThisWorkbook.Worksheets(blatt).Name, 8) = "Erhebung" Then
'hier dann die Kopierroutine
lzziel = ThisWorkbook.Worksheets("Hilfstabelle").UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1
If lzziel < 13 Then lzziel = 13
'letzte Zeile und Spalte des Quellblattes ermitteln
lzquelle = ThisWorkbook.Worksheets(blatt).UsedRange.SpecialCells(xlCellTypeLastCell).Row
lzspalte = ThisWorkbook.Worksheets(blatt).UsedRange.SpecialCells(xlCellTypeLastCell).Column

'Bereich kopieren und Werte im Arbeitsblatt Hilfstabelle einfügen
With ThisWorkbook.Worksheets(blatt)
.Range(.Cells(1, 1), .Cells(lzquelle, lzspalte)).Copy
End With
ThisWorkbook.Worksheets("Hilfstabelle").Cells(lzziel, 1).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False

End If

Next blatt

End Sub

Das Makro musst du in ein Standardmodul deiner Arbeitsmappe kopieren.

Gruß

M.O.

Answer 10

Hi,

das Kopieren und Einfügen hat auf anhieb funktioniert.

Spitze!

Nur kopiert er in den Erhebungsblättern nicht ab A9 sondern ab A1.

Wenn ich mir dein Makro so angucke weiß ich leider nicht wie ich das selber ändern kann.