Alle Tabellen kopieren und per Makro einfügen möglich? Vorhandenes Makro...

[isarc]

Hallo,

das Makro hab ich vom Internet. Ich verstehe es fast und es funktioniert soweit. Es kopiert aus allen geöffneten Excel Sheets hier immer die gerade atkive Tabelle.
Nun möchte ich gerne, dass alle Tabellen kopiert und eingefügt werden. (ich habe in einem Excel Sheets ca. 80 gleiche Tabellen mit unterschiedlichen Daten. Diese müsste ich in eine komplette Excel Tabelle untereinander komplett bringen.

Die jeweiligen Sheets lauten wie folgt:
Tabelle1, Tabelle2, Tabelle3, Tabelle4, usw..
Diese sollten dann in "Konsolidierung" komplett eingefügt werden.

Derzeit wird immer nur die aktive Tabelle kopiert und eingefügt.

Anbei der wichtige Abschnitt:
vermutlich dürfte  Workbooks.Open (Datname)  und  Windows(Datname).Activate   ausschlaggebend sein.
Danke Euch für Tipps.

Code:

While Range("p9") > 0

    Datname = Range("p9")
    Pfad = Range("b8")
    ansetz = Range("n10")
    ChDir (Pfad)
    Workbooks.Open (Datname)
    Range("a2:v50000").Copy
    Windows("Regie.xlsm").Activate
    Sheets("Konsolidierung").Select
    Range(ansetz).PasteSpecial xlPasteValues
    Range(ansetz).PasteSpecial xlPasteFormats
    SendKeys "{right}{enter}"
    Windows(Datname).Activate
    ActiveWorkbook.Close
    Sheets("Regie").Select
    Range("p10:p30").Copy Range("p9")

[ralf_b]

versuch mal das. eine ähnliche Funktion zu deinem Anliegen.
Sheet konsolidierung wird eingefügt.
alle anderen Tabellen werden untereinander dort reinkopiert, nur eine Kopfzeile(aus erster Tabelle) wird übernommen
Alle anderen Blätter werden gelöscht. 
Speicherung als Regie.xlsm. 

Code:

Sub blaetterzusammen()
Dim wks As Worksheet, i As Integer

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False

Set wks = Worksheets.Add(before:=Worksheets(1))
wks.Name = "Konsolidierung"

For i = 2 To ActiveWorkbook.Worksheets.Count
    With Worksheets(i)
        If i = 2 Then
           .UsedRange.Copy Destination:=wks.Cells(1)
        Else
             .UsedRange.Resize(.UsedRange.Rows.Count - 1).Offset(1).Copy _
                Destination:=wks.Cells(wks.UsedRange.Rows.Count + 1, 1)
        End If
    End With
Next i

wks.Cells.AutoFit

For i = ActiveWorkbook.Worksheets.Count To 1 Step -1
    If Worksheets(i).Name <> wks.Name Then Worksheets(i).Delete
Next i


wks.SaveAs Filename:=ActiveWorkbook.Path & Application.PathSeparator & "Regie.xlsm"


Application.EnableEvents = True
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

[isarc]

Hallo

danke erstmal.
Habe es probiert. Habe das Markoscript als Button hier direkt in eine neue "Tabelle22" eingebaut und ausgeführt. 
Es funktioniert . Es erscheint zwar ein Fehler bei "Objektorientiert Fehler". Komischer Weise werden alle Tabellen trotzdem in Konsolidierung_ eingefügt.

Es wird allerdings nicht unter einem neuen Sheet "Regie.xlsm" abgespeichert, warum auch immer...

Objektorientiert Fehler
.UsedRange.Resize(.UsedRange.Rows.Count - 1).Offset(1).Copy _

                Destination:=wks.Cells(wks.UsedRange.Rows.Count + 1, 1)


Ich kann dem Script nicht ganz folgen, muss man dieses komplett von Hand schreiben?
Vielleicht kannst du es kurz kommentieren, welche beim Script vollzogen werden. Vielleicht verstehe ich es dann besser?


Sub blaetterzusammen()
Dim wks As Worksheet, i As Integer

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False

Set wks = Worksheets.Add(before:=Worksheets(1))
wks.Name = "Konsolidierung"

For i = 2 To ActiveWorkbook.Worksheets.Count
    With Worksheets(i)
        If i = 2 Then
           .UsedRange.Copy Destination:=wks.Cells(1)
        Else
             .UsedRange.Resize(.UsedRange.Rows.Count - 1).Offset(1).Copy _
                Destination:=wks.Cells(wks.UsedRange.Rows.Count + 1, 1)
        End If
    End With
Next i

wks.Cells.AutoFit

For i = ActiveWorkbook.Worksheets.Count To 1 Step -1
    If Worksheets(i).Name <> wks.Name Then Worksheets(i).Delete
Next i


wks.SaveAs Filename:=ActiveWorkbook.Path & Application.PathSeparator & "Regie.xlsm"


Application.EnableEvents = True
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

[ralf_b]

ich weis nicht warum es einen Fehler bei dir auswirft.  Ich sitze ja auch nicht vor deinen Dateien. 
Fehler, die in "echten" Dateien auftreten kann ich nicht feststellen.


nein, man muß das nicht von Hand schreiben. Zumindest du nicht, weil ich das bereits getan habe, für dich. 



ich kommentiere den Code nicht weiter. Der Ablauf wurde bereits beschrieben  und so läuft es auch ab. 
Wenn du Fragen zu Programmfunktionen hast, dann markiere den Teil und google  es oder benutze die Officehilfe . 
So mache ich das auch und wenn man dir schon eine Lösung bietet, dann sei wenigstens so engagiert das du dich damit etwas auseinandersetzt.