Tabellenblätter verteilen und als Datei speichern

Forumthread: Tabellenblätter verteilen und als Datei speichern

22.10.2007 18:11:29

Stefan

Hallo zusammen,
nach langer und erfolgloser Suche im Archiv, muss ich doch einen neuen Beitrag eröffnen.
Ich habe eine .xls Datei, die aus vielen Tabellenblättern besteht. Ich wollte nun fragen, ob es möglich ist, per VBA Programmierung diese Tabellenblätter automatisch in eigene Dateien abzuspeichern?
Es sollte im Prinzip so ablaufen, dass die Tabellenblätter jeweils in einen eigenen Ordner abgelegt. Der Name jedes Ordners entspricht der Zelle C2 aus dem entsprechenden Tabellenblatt, d.h. steht in Tabelle1 in C2 der Wert 1000, soll "Tabelle1" also in den Ordner "1000" abgelegt werden, steht in Tabelle2 der Wert 2000 in C2, soll dieses Tabellenblatt im Ordner "2000" abgelegt werden. Der Speichername der .xls kann dadurch bei allen Dateien gleich sein (in diesem Fall "Kostenverfolgung.xls).
Kann mir da jemand von Euch helfen?
Viele Grüße und vorab schonmal vielen Dank,
Stefan

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Tabellenblätter einzeln als Datei speichern

22.10.2007 18:27:55

NoNet

Hallo Stefan,
mit diesem Makro ist das möglich :

Private Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" ( _
    ByVal DirPath As String) As Long
Sub BlaetterEinzelnSpeichern()
    Dim strVerzeichnis As String
    Dim shBlatt As Worksheet
    strVerzeichnis = "C:\Temp\Excel\" 'mit "\" am Ende !!!
    For Each shBlatt In ActiveWorkbook.Worksheets
        If shBlatt.[C2] <> "" Then
            'Verzeichnis anlegen, falls noch nicht vorhanden !
            MakeSureDirectoryPathExists strVerzeichnis & shBlatt.[C2].Value & "\"
            shBlatt.Copy
            ActiveWorkbook.SaveAs strVerzeichnis & ActiveSheet.[C2].Value & "\Kostenverfolgung.xls"
            ActiveWorkbook.Close False
        Else
            MsgBox shBlatt.Name, vbOKOnly + vbCritical, "Fehlender Dateiname in C2 in Blatt "
        End If
    Next
End Sub

Wenn ein Ordner noch nicht existiert, wird er auch gleich mit angelegt.
Es wird nur geprüft, ob die Zelle C2 des jeweiligen Blattes einen Inhalt hat (für eigenen ORdner), jedoch NICHT, ob es sich dabei um einen gültigen Ordnernamen handelt. Dafür musst Du also schon slebst sorgen...
Gruß, NoNet

Ähnliche Frage!

22.10.2007 18:40:21

Patrick

Ich habe ebenfalls eine Excel-Datei die mehrere Tabellen enthält. Auf einer dieser Tabellen
Sheets("Werte")
hab ich einen Speicherbutten abgelegt, der mir einen Bereich dieser Tabelle als extra Excel-Datei ablegen soll.
Wenn es möglich ist, mit der funktion speichern unter.
Vielen dank im vorraus
gruß Patrick

@Patrick

22.10.2007 19:32:00

Josef

Hallo Patrick,
mach das Nächste mal bitte einen eigenen Thread auf, das ganze wird sonst ziemlich unübersichtlich.
Das sollte es tun.
' **********************************************************************
' Modul: Modul2 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub TeilbereichSpeichern()
Dim objWB As Workbook
Dim strRange As String, strFile As String

On Error GoTo ErrExit
GMS

strRange = "A1:F20" 'Bereichsadresse die Kopiert werden soll

strFile = Application.GetSaveAsFilename( _
    fileFilter:="Excel Files (*.xls), *.xls")

If strFile <> "Falsch" Then
    Set objWB = Workbooks.Add(xlWBATWorksheet)
    ThisWorkbook.Sheets("Werte").Range(strRange).Copy
    With objWB.Sheets(1).Range("A1")
        .PasteSpecial xlPasteAll
        .PasteSpecial xlPasteValues
        .PasteSpecial xlPasteFormats
        .PasteSpecial xlPasteColumnWidths
    End With
    Application.CutCopyMode = False
    objWB.SaveAs strFile
    objWB.Close
End If

ErrExit:
GMS True
If Err <> 0 Then MsgBox Err.Description
Set objWB = Nothing
End Sub

Sub GMS(Optional ByVal Modus As Boolean = False)
Static lngCalc As Long

With Application
    .ScreenUpdating = Modus
    .EnableEvents = Modus
    .DisplayAlerts = Modus
    .EnableCancelKey = IIf(Modus, 1, 0)
    If Modus Then
        .Calculation = lngCalc
    Else
        lngCalc = .Calculation
        .Calculation = xlCalculationManual
    End If
    .Cursor = IIf(Modus, -4143, 2)
    .CutCopyMode = False
End With

End Sub

Gruß Sepp

AW: Ähnliche Frage!

25.10.2007 20:52:44

Stefan

Hallo alle zusammen,
ich schmeiß mich weg. Ich war zwei Tage weg und schon habe ich die Lösung erhalten.
An alle, die mir geantwortet haben: vielen herzlichen Dank für Eure Unterstützung!!!
Das ist echt super hier :-)))))
Viele Grüße,
Stefan

AW: Tabellenblätter verteilen und als Datei speichern

22.10.2007 18:35:55

Josef

Hallo Stefan,
probier mal.
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Private Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" _
    (ByVal lpPath As String) As Long

Sub speichern()
Dim objWS As Worksheet
Dim strPath As String, strDir As String, strName As String

strPath = "F:\Temp\Ordner" 'Stammverzeichnis in dem die Ordner angelegt werden sollen
strName = "Kostenverfolgung.xls" 'Dateiname unter dem die Dateien gespeichert werden sollen

If Right(strPath, 1) <> "\" Then strPath = strPath & "\"

For Each objWS In ThisWorkbook.Worksheets
    If objWS.Range("C2") <> "" Then
        strDir = objWS.Range("C2") & "\"
        If MakeSureDirectoryPathExists(strPath & strDir) <> 0 Then
            objWS.Copy
            ActiveWorkbook.SaveAs strPath & strDir & strName
            ActiveWorkbook.Close True
        End If
    End If
Next

End Sub

Gruß Sepp

Fast 1:1 identisch mit meinem Code ;-)) _oT

22.10.2007 18:36:58

NoNet

_oT

Zwei Narren - ein gedanke ;-)) o.T.

22.10.2007 18:52:22

Josef

Gruß Sepp

Beliebteste Forumthreads (12 Monate)

Tabellenblätter verteilen und als Datei speichern

Forumthread: Tabellenblätter verteilen und als Datei speichern

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Tabellenblätter verteilen und als Datei speichern

Forumthread: Tabellenblätter verteilen und als Datei speichern

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread