Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
940to944
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
940to944
940to944
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Mehrere Tabellen kopieren

Mehrere Tabellen kopieren
17.01.2008 11:53:00
Alex.F
Hallo !
Gibt es hierfür eine Lösung ?
In einer Arbeitsmappe habe ich 12 Tabellenblätter, die ich per Makro in ein neuerstelltes Blatt kopiere.
Die Blätter 1 bis 12 haben alle die gleiche Struktur (einige Spalten und Zeilen sind breiter und höher).
Es sollen die Zeilenhöhen und Spaltenbreiten mit kopiert werden, klappt aber nicht.
Habe einiges versucht aber ohne Erfolg.
Hat jemand eine Idee ob das geht und wenn ja - Wie ?
Einstweilen herzlichen Dank an alle, die sich für mich bemühen.
MfG Alex

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Mehrere Tabellen kopieren
17.01.2008 12:24:05
Stefan
Hallo Alex
Probiers mal damit:
Sheets(Array("Tabelle1", "Tabelle2", "Tabelle3")).Select
Sheets("Tabelle2").Activate
Sheets(Array("Tabelle1", "Tabelle2", "Tabelle3")).Copy Before:=Workbooks( _
"Mappe2").Sheets(1)
Hier werden die Tabellenblätter 1-3 in Mappe1 selectiert und dann verschoben oder kopiert in Mappe2.
Die Formatierung bleibt dann erhalten.
Gruß, Stefan

AW: Mehrere Tabellen kopieren
17.01.2008 14:51:06
Alex.F
Hallo Stefan,
habe Dank für deine Antwort aber dass suche ich nicht.
Ich habe Blatt 1 bis 12, untereinander, in ein neuerstelltes Blatt in der selben Mappe kopiert, nur die Formatierung wird nicht mit übernommen.
Für deinen Tipp hätte ich folgendes Makro genommen:

Sub TabellenKopieren()
Dim objWb As Workbook, objNeuWb As Workbook
Dim ws As Worksheet
Dim L As Long
Application.ScreenUpdating = False
Set objWb = ActiveWorkbook
Set objNeuWb = Workbooks.Add
Application.DisplayAlerts = False
For L = objNeuWb.Sheets.Count To 2 Step -1
objNeuWb.Sheets(L).Delete
Next L
For Each ws In objWb.Worksheets
ws.Copy after:=objNeuWb.Sheets(objNeuWb.Sheets.Count)
Next
objNeuWb.Sheets(1).Delete
objNeuWb.Sheets(1).Name = objWb.Sheets(1).Name
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub


Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige