Blätter in neue Dateien kopieren

Forumthread: Blätter in neue Dateien kopieren

26.02.2007 11:56:58

Ryu_Hoshi

Hallo!
Ich habe eine Excel Datei mit vielen Tabellen. Als erstes Blatt folgt eine Beschreibung und anschließend unterschiedliche Blätter. Nun möchte ich ein Makro machen welcher eine neue Datei erstellt und dort jeweils die Beschreibung (erstes Tabellblatt) und dann die anderen Blätter kopiert. Also z.B. erste Datei: erstes Blatt Beschreibung und zweites Blatt das zweite aus der Original Datei. Zweite Datei: erstes Blatt Beschreibung und zweites Blatt das dritte aus der Original Datei. Die neuen Dateien sollten nach dem Namen des zweiten Blatts benannt werden (also das was in jeder Datei unterschiedlich ist).
Ich hoffe ich habe mich veständlich ausgedrückt. Ansonsten kann ich dies gerne noch erklären. Ich denke ich müsste die Dateinamen in Array machen und von dort auslesen, aber ich habe dies schon lange nicht mehr gemacht und würde mich daher über Hilfe freuen.
Gruss
Ryu

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Ergänzung

26.02.2007 13:50:00

Ryu_Hoshi
AW: Ergänzung

26.02.2007 14:12:00

fcs
AW: Ergänzung

26.02.2007 15:28:00

Ryu_Hoshi

Ergänzung

26.02.2007 13:50:00

Ryu_Hoshi

Ich habe versucht den Code zu schreiben, aber es sind noch Fehler drin. Vielleicht sieht sie jemand:
"


Sub Blätter_verteilen()
Dim wkb As Workbook
Dim i As Integer
Dim k As Integer
Dim x1 As Integer
Dim x2 As Integer
wkb = Workbooks("Delivery Performance IC Feb 07.xls")
x1 = wkb.Worksheets.Count
For i = 2 To x1
Workbooks.Add
ActiveWorkbook.Name = wkb.Worksheet(i)
wkb.Worksheet("Important").Copy Before:=ActiveWorkbook.Sheets(1)
wkb.Worksheet(i).Copy Before:=ActiveWorkbook.Sheets(2)
x2 = ActiveWorkbook.Worksheets.Count
For k = x2 To 3 Step -1
Worksheets(k).Delete
Next k
ActiveWorkbook.SaveAs Filename:="G:\test\" & i & ".xls"
ActiveWindow.Close
End If
End Sub

AW: Ergänzung

26.02.2007 14:12:00

fcs

Hallo Ryu,
hier eine angepasste, vereinfachte Version deines Makros.
Gruß
Franz


Sub Blätter_verteilen()
Dim wkb As Workbook, wkbNeu As Workbook
Dim i As Integer
Dim x1 As Integer
'  Set wkb = ActiveWorkbook
Set wkb = Workbooks("Delivery Performance IC Feb 07.xls")
x1 = wkb.Worksheets.Count
For i = 2 To x1
wkb.Worksheets("Important").Copy
Set wkbNeu = ActiveWorkbook
wkb.Worksheets(i).Copy After:=wkbNeu.Sheets("Important")
wkbNeu.SaveAs Filename:="G:\test\" & wkb.Worksheets(i).Name & ".xls"
wkbNeu.Close
Next
End Sub

AW: Ergänzung

26.02.2007 15:28:00

Ryu_Hoshi

Hallo fcs,
danke für deine Hilfe. Der Makro funktioniert gut.
Gruss
Ryu

Beliebteste Forumthreads (12 Monate)

Blätter in neue Dateien kopieren

Forumthread: Blätter in neue Dateien kopieren

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread