Clever-Excel-Forum

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")

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

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

[Bild: excelfehler.png]

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.

isarc

ralf_b

isarc

ralf_b