Office 2007: Bestimmte Arbeitsblätter in eine Datei speichern

[medic]

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.


<sup>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</sup>

Schon mla vielen Dank!

[Beverly]

Hi,

hier ein Code zum Kopieren der mit "x" gekennzeichneten Tabellenblätter in eine neue (nicht gespeicherte) Arbeitsmappe:

Code: [Auswählen]

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

[medic]

Wow! Super! Danke!
Funktioniert einwandfrei!
Grüße und schöne Woche!

[medic]

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")

[Officer]

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