Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1444to1448
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

Alle Arbeitsblätter als einzelene Datei speichern

Alle Arbeitsblätter als einzelene Datei speichern
11.09.2015 15:56:11
Gavri
Hallo
Ich habe folgendes Problem: Ich möchte bis auf die ersten beiden Arbeitsblätter (Formatliste und Pfad) alle Arbeitsblätter als einzelne Datei speichern.
Der jeweilige Pfad in dem die Arbeitsblätter gespeichert werden sollen, steht im Arbeitsblatt „Pfad“ Spalte B ab Zeile 6 in Spalte A steht der Name des dazugehörigen Blattes. Es können noch weitere Kunden im Laufe der Zeit dazukommen, daher soll es die Möglichkeit geben den Pfad in Excel vorzugeben.
Der Dateiname sollte wie folgt aussehen: Monat/Jahr (aus Pfad/Zelle A2)&_&Arbeitsblattname.xlsx
Es sollte eine Prüfung geben, ob diese Datei schon angelegt ist, wenn ja dann soll sie automatische als „Dateiname(1)“ gespeichert werden.
Wenn es den Pfad nicht gibt, langt eine Fehlermeldung, es soll nicht der Pfad angelegt werden.
Wäre schön, wenn das in meinen Code mit eingearbeitet werden kann.
Eine Musterdatei habe ich angehängt: www.herber.de/bbs/user/100141.xlsm
Meine VBA Kenntnisse bestehen aus suchen und zusammen basteln.
Vorab schon mal vielen Dank für die Hilfe.

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

Betreff
Datum
Anwender
Anzeige
AW: Alle Arbeitsblätter als einzelene Datei speichern
11.09.2015 16:33:06
Stefan
Auch bei mir beschränkt sich das VBA auf suchen, ändern, einbauen und erfolglos probieren bis ein Glücksmoment kommt.
So habe ich es bei mir gemacht:
If Not IsEmpty(Worksheets("Rechnung").Range("D10").Value) Then
Worksheets("Rechnung").Copy
With ActiveWorkbook
With Worksheets("Rechnung").UsedRange
.Copy
.PasteSpecial Paste:=xlPasteValues
End With
Call .SaveAs(Filename:="E:\daten\sdoliwa\Eigene Dokumente\2012\Vorgesorgt\Angebote\" & "Angebot" & _
.Worksheets("Rechnung").Range("H2").Text & ".xlsm", _
FileFormat:=xlOpenXMLWorkbookMacroEnabled)
Call .Close(SaveChanges:=False)
End With
End If

Anzeige
Alle Arbeitsblätter als einzelene Datei speichern
11.09.2015 16:44:11
Gavri
Hallo Stefan,
bei dir handelt sich es um eine einzelnes Blatt mit einem festen Pfad. Dafür gibt es genügend Beispiel im Netz.
Bei mir sind es diverse Arbeitsblätter mit unterschiedlichen Pfaden.
Aber trotzdem Danke.

AW: Alle Arbeitsblätter als einzelene Datei speichern
11.09.2015 20:39:30
Sepp
Hallo Gabriel,
probier mal.
' **********************************************************************
' Modul: Modul2 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub SaveAllSheets()
Dim objSh As Worksheet
Dim strPath As String, strFileName As String, strFile As String
Dim vntRet As Variant
Dim lngI As Long

On Error GoTo ErrExit

With Application
  .ScreenUpdating = False
  .EnableEvents = False
  .Calculation = xlManual
  .DisplayAlerts = False
End With

For Each objSh In ThisWorkbook.Worksheets
  lngI = 0
  Select Case objSh.Name
    Case "Formatliste", "Pfad" 'Tabellen die NICHT gespeichert werden sollen!
    Case Else
      vntRet = Application.Match(objSh.Name, Sheets("Pfad").Columns(1), 0)
      If IsNumeric(vntRet) Then
        strPath = Sheets("Pfad").Cells(vntRet, 2).Text
        If Right(strPath, 1) <> "\" Then strPath = strPath & "\"
        If Dir(strPath, vbDirectory) <> "" Then
          strFileName = strPath & Sheets("Pfad").Range("A2").Text & "_" & objSh.Name & ".xlsx"
          strFile = Dir(strFileName, vbNormal)
          Do While strFile <> ""
            lngI = lngI + 1
            strFileName = strPath & Sheets("Pfad").Range("A2").Text & "_" & objSh.Name & "(" & lngI & ").xlsx"
            strFile = Dir(strFileName, vbNormal)
          Loop
          objSh.Copy
          With ActiveWorkbook
            .SaveAs strFileName, 51
            .Close
          End With
        Else
          MsgBox "Der Pfad '" & strPath & "' für die Tabelle '" & objSh.Name & "' existiert nicht!", vbExclamation
        End If
      Else
        MsgBox "Für die Tabelle '" & objSh.Name & "' ist kein Pfad hinterlegt!", vbExclamation
      End If
  End Select
Next

ErrExit:

With Err
  If .Number <> 0 Then
    MsgBox "Fehler in Prozedur:" & vbTab & "'SaveAllSheets'" & vbLf & String(60, "_") & _
      vbLf & vbLf & IIf(Erl, "Fehler in Zeile:" & vbTab & Erl & vbLf & vbLf, "") & _
      "Fehlernummer:" & vbTab & .Number & vbLf & vbLf & "Beschreibung:" & vbTab & _
      .Description & vbLf, vbExclamation + vbMsgBoxSetForeground, _
      "VBA - Fehler in Prozedur - SaveAllSheets"
    .Clear
  End If
End With

On Error GoTo 0

With Application
  .ScreenUpdating = True
  .EnableEvents = True
  .Calculation = xlAutomatic
  .DisplayAlerts = True
  .StatusBar = False
End With


End Sub


Gruß Sepp

Anzeige
Alle Arbeitsblätter als einzelene Datei speichern
14.09.2015 09:42:51
Gavri
Hallo Sepp,
das funktioniert Prima. Vielen Dank für die Unterstützung.
Gruß
Gavri

313 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige