Office: Tabellenblätter von einer Mappe in eine andere kopieren

coko · 26. Oktober 2010

Hallo!

Ich habe hier etliche Arbeitsmappen, die alle die gleichen Tabellenblätter enthalten. Nun muss in allen Mappen jeweils die gleichen Korrekturen vornehmen (Tabelle "ER" die Seite einrichten und Tabelle "Rabit_Input" die Spaltenüberschriften entfernen). Das Makro hierfür habe ich aufgezeichnet, ein bisschen angepasst und es funktioniert so wie ich es möchte.
Ausserdem enthält die Arbeitsmappe 4 ausgeblendete Tabellen ("30.9." / "CheckBilanz" / "CheckER" und "CheckDiverses"). Diese Tabellen werden eingeblendet und dann die letzten 3 gelöscht, weil ich diese Tabellen durch neue (welche Korrekturen enthalten) ersetzen muss.
Bis zum Löschen der Tabellenblätter funktioniert der Code wunderbar. Aber dann möchte ich in die Vorlagen-Arbeitsmappe wechseln, dort die gleichen 3 Tabellen kopieren und in die eigentliche Arbeitsmappe einfügen. Der Wechsel in die Vorlagen-Mappe ("2010_Q4-Reporting.xlsx"), das selektieren und kopieren funktioniert auch noch. Dann bleibt das Makro stehen *frown.gif*

Ich finde nicht heraus, wie ich wieder in die eigentliche Arbeitsmappe (ZielMappe) wechseln und die kopierten Tabellenblätter dort einfügen kann. Hab schon einiges gegoogelt und ausprobiert, aber es funktioniert einfach nicht…Kann mir vielleicht jemand weiterhelfen?

Herzlichen Dank im Voraus!
LG coko

PS: Ich habe jeweils die ZielMappe und die Vorlagen-Mappe geöffnet, befindet mich in der ZielMappe und starte das Makro manuell.

Hier mein Code:

Code:

Sub Repo_Q3()

Dim ZielMappe As Workbook
Set ZielMappe = ThisWorkbook

Sheets("ER").Select
ActiveWindow.View = xlPageBreakPreview
ActiveSheet.ResetAllPageBreaks
ActiveSheet.VPageBreaks(1).DragOff Direction:=xlToRight, RegionIndex:=1
ActiveWindow.SmallScroll Down:=40
Set ActiveSheet.HPageBreaks(1).Location = Range("A72")
ActiveWindow.View = xlNormalView
ActiveWindow.Zoom = 120

Sheets("RABIT_Input").Select
With ActiveSheet.PageSetup
.PrintHeadings = False
End With

Sheets("30.9.").Visible = True
Sheets("CheckBilanz").Visible = True
Sheets("CheckER").Visible = True
Sheets("CheckDiverses").Visible = True
Sheets(Array("CheckBilanz", "CheckER", "CheckDiverses")).Select
ActiveWindow.SelectedSheets.Delete

Windows("2010_Q4-Reporting.xlsx").Activate
Sheets(Array("CheckBilanz", "CheckER", "CheckDiverses")).Select
Sheets(Array("CheckBilanz", "CheckER", "CheckDiverses")).Copy After:=ThisWorkbook.Worksheets(Worksheets.Count)

End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

:)

jinx · 28. Oktober 2010

Moin, coko,

ungetestet:

Code:

Sub Repo_Q3()

Dim ZielMappe As Workbook
Set ZielMappe = ThisWorkbook

With Sheets("ER")
.ResetAllPageBreaks
.VPageBreaks(1).DragOff Direction:=xlToRight, RegionIndex:=1
Set .HPageBreaks(1).Location = Range("A72")
.Select
End With

With ActiveWindow
.View = xlPageBreakPreview
.View = xlNormalView
.Zoom = 120
End With

With Sheets("RABIT_Input").PageSetup
.PrintHeadings = False
End With

Application.DisplayAlerts = False
Sheets("30.9.").Visible = True
With Sheets("CheckBilanz")
.Visible = True
.Delete
End With
With Sheets("CheckER")
.Visible = True
.Delete
End With
With Sheets("CheckDiverses")
.Visible = True
.Delete
End With
Application.DisplayAlerts = True

With Windows("2010_Q4-Reporting.xlsx")
Sheets("CheckBilanz").Copy After:=ThisWorkbook.Worksheets(Worksheets.Count)
Sheets("CheckER").Copy After:=ThisWorkbook.Worksheets(Worksheets.Count)
Sheets("CheckDiverses").Copy After:=ThisWorkbook.Worksheets(Worksheets.Count)
End With

End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

coko · 28. Oktober 2010

Hallo Jinx!

Herzlichen Dank für deine Antwort. Ich habe den angepassten Code ausprobiert:

bei den Zeilen
Code:

.VPageBreaks(1).DragOff Direction:=xlToRight, RegionIndex:=1
Set .HPageBreaks(1).Location = Range("A72")
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

erscheint ein Laufzeitfehler 1004: Anwendungs-oder objektdefinierter Fehler

Ich hatte diese Zeilen betreffend dem Blatt "ER" auch schon so geschrieben wie du und bin mit der gleichen Fehlermeldung konfrontiert worden. Nach einer halben Stunde "rumprobieren" war's mir dann zu blöd und so habe ich halt doch den Code vom Makro-Rekorder verwendet. Hauptsache es funktioniert *wink.gif*

bei den Zeilen
Code:

Sheets("CheckBilanz").Copy After:=ThisWorkbook.Worksheets(Worksheets.Count)
Sheets("CheckER").Copy After:=ThisWorkbook.Worksheets(Worksheets.Count)
Sheets("CheckDiverses").Copy After:=ThisWorkbook.Worksheets(Worksheets.Count)
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

erscheint ein Laufzeitfehler 9: Index ausserhalb des gültigen Bereichs

Da in der Arbeitsmappe ganz am Ende noch eine veryhidden Tabelle steht, dachte ich, dass so vielleicht die kopierten Tabellen nichts ans Ende gestellt werden können. Deshalb habe ich anstatt
After:=ThisWorkbook.Worksheets(Worksheets.Count) dann folgendes probiert
After:=ThisWorkbook.Worksheets("30.9.") resp. ("CheckBilanz") und ("CheckER")
das hat aber leider auch nicht geklappt...

Den ersten Laufzeitfehler betreffend PageBreak werde ich nicht mehr weiterverfolgen, weil der Makro-Code ja funktioniert. (Es handelt sich hier um ein "Wegwerf-Makro", das ich nur dieses eine Mal für das 3. Quartal benötige).

Aber wenn du mir beim zweiten Laufzeitfehler weiterhelfen kannst, wäre ich sehr dankbar!

Herzliche Grüsse
coko

jinx · 29. Oktober 2010

Moin, coko,

tja, da habe ich den Punkt vergessen, der eine Beziehung zwischen der Mappe und den Tabelle herstellt, die kopiert werden sollen (ggf. noch ThisWorkbook vor die Zählung der Tabellen stellen):

Code:

With Workbooks("2010_Q4-Reporting.xlsx")
.Sheets("CheckBilanz").Copy After:=ThisWorkbook.Worksheets(Worksheets.Count)
.Sheets("CheckER").Copy After:=ThisWorkbook.Worksheets(Worksheets.Count)
.Sheets("CheckDiverses").Copy After:=ThisWorkbook.Worksheets(Worksheets.Count)
End With
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Ansonsten versucht Excel, die Tabellen aus der gerade aktiven Mappe zu kopieren - und das dürfte den Laufzeitfehler hervorrufen...

coko · 4. November 2010

Hallo Jinx!

Leider hat weder der Punkt noch die Variante ThisWorkbood das gewünschte Resultat gebracht.. ich hab noch verschiedene andere Varianten probiert, aber es kam immer wieder der Laufzeitfehler.

Dann habe ich (aufgrund eines Code-Schnipsels aus einem Forum) die ganze Sache umgedreht:

Ich öffne nun als Erstes die QuellDatei und starte das Makro. Dieses öffnet dann selber nach dem CopyBefehl die Zieldatei und fügt die kopierten Tabellen dort ein und passt die Verknüpfung von der QuellDatei auf die Zieldatei an. Dann kommen noch die paar "Schönheitskorrekturen", die fertige Datei wird gespeichert, ausgedruckt und geschlossen. Ausserdem habe ich das Makro so erweitert, dass nun alle ZielDateien in einem bestimmten Verzeichnis nacheinander selbstständig so abgearbeitet werden.

Hier ist der entsprechende Code für Interessierte:
Code:

Sub Repo_Q3()
Dim Ziel As Workbook
Dim Blatt1 As Worksheet
Dim Blatt2 As Worksheet
Dim Blatt3 As Worksheet

Dim fs As Object
Dim fVerz As Object
Dim fDatei As Object
Dim fDateien As Object

Set Blatt1 = Worksheets("CheckBilanz")
Set Blatt2 = Worksheets("CheckER")
Set Blatt3 = Worksheets("CheckDiverses")

Set fs = CreateObject("Scripting.FileSystemObject")
Set fVerz = fs.GetFolder("H:\Dateien\")
Set fDateien = fVerz.Files

For Each fDatei in fDateien

Application.DisplayAlerts = False
Set Ziel = Workbooks.Open(fDatei)
Application.DisplayAlerts = True

Application.DisplayAlerts = False
Sheets("30.9.").Visible = True
With Sheets("CheckBilanz")
.Visible = True
.Delete
End With
With Sheets("CheckER")
.Visible = True
.Delete
End With
With Sheets("CheckDiverses")
.Visible = True
.Delete
End With
Application.DisplayAlerts = True

Blatt1.Copy After:=Ziel.Sheets(Worksheets.Count)
Blatt2.Copy After:=Ziel.Sheets(Worksheets.Count)
Blatt3.Copy After:=Ziel.Sheets(Worksheets.Count)

Sheets("ER").Select
ActiveWindow.View = xlPageBreakPreview
ActiveSheet.ResetAllPageBreaks
ActiveSheet.VPageBreaks(1).DragOff Direction:=xlToRight, RegionIndex:=1
Set ActiveSheet.HPageBreaks(1).Location = Range("A72")
ActiveWindow.View = xlNormalView
ActiveWindow.Zoom = 120

With Sheets("RABIT_Input").PageSetup
.PrintHeadings = False
End With

ActiveSheet.Unprotect "Passwort"

Application.DisplayAlerts = False
ActiveWorkbook.ChangeLink Name:="Vorlage.xlsx", NewName:= _
Ziel.Name, Type:=xlExcelLinks
Application.DisplayAlerts = True

ActiveWorkbook.Save
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
Sheets(Array("Lieferschein", "Bilanz", "ER", "Tabelle E", "Erfolgs-Analyse", _
"EK-Analyse", "Ergänzende Angaben", "RABIT_Input", "RABIT_Output", "30.9.", _
"CheckBilanz", "CheckER", "CheckDiverses")).Select
Application.ActivePrinter = "\\S2001-PR010\p2001-2096pcl5 auf Ne05:"
ExecuteExcel4Macro _
"PRINT(1,,,1,,,,,,,,2,""\\S2001-PR010\p2001-2096pcl5 auf Ne05:"",,TRUE,,FALSE)"
Sheets("Lieferschein").Select
ActiveWorkbook.Save
ActiveWorkbook.Close

Next fDatei

End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Sicher kein professioneller Code, aber er tut was ich will und nimmt mir eine Menge Fleissarbeit ab*Smilie

Herzlichen Dank für deine Unterstützung!

LG coko

Office: Tabellenblätter von einer Mappe in eine andere kopieren

Tabellenblätter von einer Mappe in eine andere kopieren

Tabellenblätter von einer Mappe in eine andere kopieren

Tabellenblätter von einer Mappe in eine andere kopieren

Tabellenblätter von einer Mappe in eine andere kopieren - Similar Threads - Tabellenblätter Mappe kopieren

Arbeitszeiten aus mehreren Tabellenblätter

Tabellenblatt in neue Mappe kopieren

Tabellenblätter per Makro exportieren in eigene Mappe

Per Makro Tabellenblätter von Mappe A nach Mappe B kopieren und umbennenen

Tabellenblatt bei kopie als Mappe neu benennen

Tabellenblatt in eine Bestimme Mappe kopieren

Werte von Tabellenblättern der selben Mappe „holen“