Live-Forum - Die aktuellen Beiträge
Datum
Titel
23.04.2024 14:59:21
23.04.2024 14:47:39
23.04.2024 14:23:45
Anzeige
Archiv - Navigation
1252to1256
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
Inhaltsverzeichnis

Sheets in neues Workbook kopieren

Sheets in neues Workbook kopieren
Mike
Hallo,
ich möchte aus einer Excel-Datei heraus eine neue Excel-Datei erstellen. Das klappt auch soweit, hier das Makro
Sub Datei_neu()
Dim intAbfrageWert As Integer
Dim strDateiName As String
intAbfrageWert = MsgBox(" Wollen Sie eine Datei in dem Pfad " & ActiveWorkbook.Path & "  _
erstellen?", _
vbYesNo + vbQuestion, "Datei erstellen", "", 0)
If intAbfrageWert = 6 Then
strDateiName = InputBox("Geben Sie einen Dateinamen ein", "Dateiname")
Workbooks.Add
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & strDateiName, _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
Else
MsgBox "Vorgang abgebrochen"
End If
End Sub
Nun möchte ich aber, aus jedem der Sheets der aktuellen Datei (bis auf das Erste) die Spalten, A,B,C,H in das neue
Workbook in die Spalten A,B,C,D einfügen.
Wie kann ich das machen? Wie kann ich aus dem aktuellen Workbook auf die Sheet-Attribute (wie Namen, Spalten) etc. des neuen Workbooks zugreifen zugreifen? Muss das Workbook dazu geöffnet sein?
Gruß!

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Sheets in neues Workbook kopieren
15.03.2012 14:04:38
Frank
Hallo Mike,
so sollte das gehen:
Sub Datei_neu()
Dim intAbfrageWert As Integer
Dim strDateiName As String
Dim strDateiOrig As String
Dim intAnzSheets As Integer
strDateiOrig = ActiveWorkbook.Name
intAbfrageWert = MsgBox(" Wollen Sie eine Datei in dem Pfad " & ActiveWorkbook.Path & " _
erstellen?", _
vbYesNo + vbQuestion, "Datei erstellen", "", 0)
If intAbfrageWert = 6 Then
strDateiName = InputBox("Geben Sie einen Dateinamen ein", "Dateiname")
Workbooks.Add
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & strDateiName, _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
intAnzSheets = ActiveWorkbook.Worksheets.Count
strDateiName = ActiveWorkbook.Name
Workbooks(strDateiName).Activate
Application.DisplayAlerts = False
For i = intAnzSheets To 2 Step -1
Workbooks(strDateiName).Worksheets(i).Delete
Next
Application.DisplayAlerts = True
Workbooks(strDateiOrig).Activate
intAnzSheets = ActiveWorkbook.Worksheets.Count
For i = intAnzSheets To 2 Step -1
Sheets(Array(i)).Copy After:=Workbooks(strDateiName). _
Sheets(1)
Next
Else
MsgBox "Vorgang abgebrochen"
Exit Sub
End If
Workbooks(strDateiName).Activate
intAnzSheets = ActiveWorkbook.Worksheets.Count
For i = 2 To intAnzSheets
ActiveWorkbook.Sheets(i).Activate
Columns("D:G").Select
Selection.Delete Shift:=xlToLeft
Next
Application.DisplayAlerts = False
Workbooks(strDateiName).Worksheets(1).Delete
Application.DisplayAlerts = True
End Sub

Gruß
Frank
Anzeige
AW: Sheets in neues Workbook kopieren
15.03.2012 14:21:28
Mike
Puh!
Ich bin baff!
Vielen Dank! Das rennt wie eine 1. Danke Dir Frank!
Aber was bedeutet Sheets(Array(i)).Copy After:=Workbooks(strDateiName).Sheets(1)
ein Array hast Du doch gar nicht definiert?
Gruß!
AW: Sheets in neues Workbook kopieren
15.03.2012 14:39:36
Frank
Hallo Mike,
der Array war in der Tat unnötig. Das habe ich aus einem anderen Makro von mir geklaut, in dem mehrere Sheets kopiert werden, die in Anzahl und Name immer gleich sind.
Original:
Sheets(Array("Source", "Summary")).Copy After:=Workbooks(FSM). _
Sheets(1)
So müsste es auch gehen, habe ich jetzt aber nicht getestet:
Sheets(i).Copy After:=Workbooks(strDateiName). _
Sheets(1)
Gruß
Frank
Anzeige
AW: Sheets in neues Workbook kopieren
15.03.2012 15:34:31
Mike
Geht auch so!
Wunderbar, Vielen Dank!
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige
Archiv - Verwandte Themen
Forumthread
Beiträge