Microsoft Office Forum [ www.Office-Fragen.de ] >> READONLY <<
Microsoft Office 2003-2019 => Excel => Thema gestartet von: medic am April 10, 2012, 08:07:16 Vormittag
-
Schönen guten Morgen zusammen,
ich habe eine Datei mit recht vielen Arbeitsblättern (ca. 40). Nun habe ich in einem Arbeitsblatt in einer Spalte eine Übersicht der Arbeitsblätter erstellt und möchte dort bestimmte Arbeitsblätter (in der Spalte daneben) markieren (z.B. durch ein "X"), die dann in eine neue Datei exportiert (kopiert) werden sollen. Die Zusammenstellung der Arbeitsblätter, die in einer neuen Datei exportiert werden soll, variiert ständig. Der (neue) Namen der Datei soll in einer anderen Zelle angegeben werden. Da ich nicht ausschliessen kann, dass die Blätter manchmal "händisch" verschoben werden oder neue dazukommen, will ich mit den Namen der Arbeitsblätter arbeiten. Ich habe mal eine "banaliserte" Exceltabelle" als Bespiel hochgeladen
Hat jemand spontan eine Lösung?
Von einem anderen Projekt habe ich ein Script, mit dem ich einzelne Arbeitsblätter exportieren kann. Ich bekomme es aber nicht hin, eine "Schleife" einzubauen, damit mehrere (beliebige) Arbeitsblätter exportiert werden.
Sub Export()
Dim vntBlaetter As Variant
Dim sPfad As String
Dim ws As Worksheet
Dim wbkNeu As Workbook
sPfad = Worksheets("Master").Range("B2")
vntBlaetter = Array("Tabelle2")
Sheets(vntBlaetter).Copy
With ActiveWorkbook
For Each ws In .Worksheets
With ws.UsedRange
.Value = .Value
End With
Next
On Error GoTo ENDE
Application.DisplayAlerts = False
.SaveAs sPfad, xlNormal
.Close False
End With
ENDE:
Application.DisplayAlerts = True
End Sub
Schon mla vielen Dank!
-
Hi,
hier ein Code zum Kopieren der mit "x" gekennzeichneten Tabellenblätter in eine neue (nicht gespeicherte) Arbeitsmappe:
Sub Kopieren()
Dim rngZelle As Range
Dim arrTabellen()
Dim lngZaehler As Long
Dim wksTab As Worksheet
For Each rngZelle In Columns(1).SpecialCells(xlCellTypeConstants)
If UCase(rngZelle) = "X" Then
On Error Resume Next
Set wksTab = Worksheets(rngZelle.Offset(0, 1).Value)
On Error GoTo 0
If Not wksTab Is Nothing Then
ReDim Preserve arrTabellen(0 To lngZaehler)
arrTabellen(lngZaehler) = rngZelle.Offset(0, 1)
lngZaehler = lngZaehler + 1
End If
Set wksTab = Nothing
End If
Next rngZelle
Worksheets(arrTabellen()).Copy
End Sub
Beachte: die aufgelisteten Namen der Tabellenblätter müssen mit den tatsächlichen Namen übereinstimmen - sonst wird nichts kopiert.
Bis später,
Karin
-
Wow! Super! Danke!
Funktioniert einwandfrei!
Grüße und schöne Woche!
-
Wie kann ich denn in einer Zelle einen Pfad angeben, unter denn die die aufgelisteten Namen der Tabellenblätter abgespeichert werden sollen?
also z.B. sPfad = Worksheets("Tabelle").Range("R11")???
-
Hallo medic,
bitte erstelle für Deine Frage einen neuen Thread. Damit sind die Chancen auf eine Antwort wesentlich größer, als in einem bereits als gelöst markierten Thema.
Vielen Dank
Officer