Live-Forum - Die aktuellen Beiträge
Datum
Titel
23.10.2025 06:53:43
Zeilen löschen oder ausblenden wenn Zeile darüber höher wird
22.10.2025 19:40:18
Prüfen ob Datei offen
22.10.2025 19:07:50
Bedingtes kopieren in andere A.-Blätter u. VBA Anpassungen
22.10.2025 16:04:18
Auswahl der Datenüberprüfung auf Folgezellen übertragen
Keine passende Antwort im Forumarchiv gefunden?
Stelle deine Frage im Live-Forum
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
680to684
680to684
Aktuelles Verzeichnis
Verzeichnis Übersicht
Verzeichnis Übersicht
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

VBA Macro

Forumthread: VBA Macro

VBA Macro
12.10.2005 07:42:55
Michael
Mein Problem von gestern ist leider noch nicht ganz gelöst. Es geht um 80 Excel Dateien, die in einem Verzeichnis liegen und die aus je ca. 50 Tabellenblättern bestehen. Ich möchte für jedes Tabellenblatt inklusive Inhalt (!!!) eine eigene Exceldatei erstellen.Der Inhalt der Dateien soll also auch abgespeichert werden .Der Dateiname setzt sich zusammen aus Dateiname der Exceltabelle und Tabellenblattname. Die Exceltabellen liegen in einem Verzeichnis. In dieses Verzeichnis können auch die neuemn Dateien gespeichert werden. Der gesamte Ablauf sollte automatisiert ablaufen. Ich füge das Script, welches mir freundlicher Weise Matthias G geliefert hat hier ein:
Der Code für eine Datei:

Sub BlaetterSpeichern(Pfad As String, Dateiname As String)
Dim ws As Worksheet, wb As Workbook
If Right(Pfad, 1) <> "\" Then Pfad = Pfad & "\"
Set wb = Workbooks.Open(Pfad & Dateiname)
For Each ws In wb.Worksheets
ws.Copy
With ActiveWorkbook
.SaveAs Filename:=Pfad & Replace(Dateiname, ".xls", "") & "_" & ws.Name
.Close
End With
Next ws
wb.Close False
End Sub



Sub Aufruf()
BlaetterSpeichern ThisWorkbook.Path, "d1.xls"
End Sub

Anzeige

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: VBA Macro
12.10.2005 10:11:58
Matthias
Hallo Michael,
in ein Standardmodul:

Option Explicit
Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" (ByVal Pfad As String) As Long
Sub BlaetterSpeichern(Pfad As String, Dateiname As String, Ordner As String)
Dim ws As Worksheet, wb As Workbook
If Right(Pfad, 1) <> "\" Then Pfad = Pfad & "\"
Set wb = Workbooks.Open(Pfad & Dateiname)
For Each ws In wb.Worksheets
ws.Copy
With ActiveWorkbook
.SaveAs Filename:=Pfad & Ordner & "\" & Replace(Dateiname, ".xls", "") & "_" & ws.Name
.Close
End With
Next ws
wb.Close False
End Sub
Sub Aufruf()
Dim fn As String, Pfad As String, Unterordner As String
Dim i As Integer
Pfad = "D:\xl\Meier\"   'anpassen!
Unterordner = "Split"   'anpassen!
'Ordner b.B. erstellen:
MakeSureDirectoryPathExists Pfad & Unterordner & "\"
'Schleife: alle *.xls-Dateien
fn = Dir(Pfad & "\*.xls")
Do While fn <> ""
BlaetterSpeichern Pfad, fn, Unterordner
i = i + 1
fn = Dir()
Loop
MsgBox i & " Dateien barbeitet."
End Sub

Gruß Matthias
Anzeige
;

Beliebteste Forumthreads (12 Monate)

Jetzt das Excel-Portal bewerten: Deine Stimme zählt!
Anzeige
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige