Anzeige
Archiv - Navigation
1596to1600
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
Tabelle als Datei speichern
22.12.2017 10:33:00
Sigrid
Guten Morgen,
vielleicht kann jemand helfen.
Ich möchte gern eine Tabelle also Sheet als Eigenständige Datei speichern.
Also der Sheet-Name ist "Sigrid" und die Datei soll also als
"Sigrid.xlms" gespeichert werden, danach möchte ich die
neue Datei noch bearbeiten und dann speichern/schließen.
Die Orginaldatei soll im Hintergrund offen bleiben, damit
ich später weiter arbeiten kann.
gruß
sigrid

18
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Tabelle als Datei speichern
22.12.2017 10:40:14
Sepp
Hallo Sigrid,
Sub saveSheet()
Dim strPath As String

strPath = ThisWorkbook.Path 'oder ="C:\Sigrid"

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

Sheets("Sigrid").Copy

With ActiveWorkbook
  .SaveAs Filename:=strPath & Sheets(1).Name & ".xlsm", FileFormat:=52
  .Close
End With

End Sub

Gruß Sepp

Anzeige
ich kaufe noch einen . ;-)
22.12.2017 10:48:01
Sepp
Sub saveSheet()
Dim strPath As String

strPath = ThisWorkbook.Path 'oder ="C:\Sigrid"

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

Sheets("Sigrid").Copy

With ActiveWorkbook
  .SaveAs Filename:=strPath & .Sheets(1).Name & ".xlsm", FileFormat:=52
  .Close
End With

End Sub

Gruß Sepp

Anzeige
Sepp super...kann man noch
22.12.2017 10:54:49
Sigrid
Guten Morgen Sepp,
sehr schnell !
Funktioniert, kann man noch den Speicherort auswählen über ein Menü
oder so ?
gruß
sigrid
AW: Sepp super...kann man noch
22.12.2017 10:57:25
Sepp
Hallo Sigrid,
kein Problem.
Sub saveSheet()
Dim strPath As String

With Application.FileDialog(msoFileDialogFolderPicker)
  .InitialFileName = ThisWorkbook.Path 'oder "C:\Sigrid"
  .Title = "Ordnerauswahl"
  .ButtonName = "Auswahl..."
  .InitialView = msoFileDialogViewList
  If .Show = -1 Then
    strPath = .SelectedItems(1)
    If Right(strPath, 1) <> "\" Then strPath = strPath & "\"
  End If
End With

If Len(strPath) Then
  
  Sheets("Sigrid").Copy
  
  With ActiveWorkbook
    .SaveAs Filename:=strPath & .Sheets(1).Name & ".xlsm", FileFormat:=52
    .Close
  End With
End If

End Sub


Gruß Sepp

Anzeige
Ja aber...
22.12.2017 11:11:12
Sigrid
Hallo Sepp,
das aktuelle Verzeichnis wird aufgerufen, kommt allerdings Hinweis
"Sigrid" Pfad ist nicht vorhanden, obwohl vorhanden ist.
Wenn ich dann auf das Verzeichnis klicke klappt es.
Ich wollte dies auch meinem Kollegen geben, wenn kein Verzeichnis angelegt wurde,
kann man dies ggf. auch erstellen ?
Geht das noch weiter, wenn Datei vorhanden Info und ggf. den Namen ändern ?
Der Sheet Name steht in Zelle B2.
Würde mich freuen wenn dies alles noch klappt !!!
gruß
sigrid
AW: Ja aber...
22.12.2017 11:28:46
Sepp
Hallo Sigrid,
alles kein Problem, habe jetzt aber keine Zeit, erst am Abend wieder.
Gruß Sepp

Anzeige
Super Sepp würde mich freuen !
22.12.2017 11:35:10
Sigrid
Hallo Sepp,
danke im Voraus,
freu mich auf heute Abend.
gruß
sigrid
AW: Super Sepp würde mich freuen !
22.12.2017 14:34:13
Sepp
Hallo Sigrid,
war doch schneller als gedacht.
' **********************************************************************
' Modul: Modul3 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub saveSheet()
Dim strPath As String, strFileName As String, strNewName As String

Const cstrTabToCopy As String = "Sigrid" 'Tabelle die kopiert werden soll - Anpassen!

With Application.FileDialog(msoFileDialogFolderPicker)
  .InitialFileName = ThisWorkbook.Path 'oder "C:\Sigrid"
  .Title = "Ordnerauswahl"
  .ButtonName = "Auswahl..."
  .InitialView = msoFileDialogViewList
  If .Show = -1 Then
    strPath = .SelectedItems(1)
    If Right(strPath, 1) <> "\" Then strPath = strPath & "\"
  End If
End With

If Len(strPath) Then
  strFileName = strPath & Sheets(cstrTabToCopy).Range("B2").Text & ".xlsm"
  If Dir(strFileName, vbNormal) <> "" Then
    strNewName = InputBox("Die Datei" & vbLf & "'" & strFileName & "'" & vbLf & _
      "ist bereits vorhanden!" & vbLf & vbLf & "Wollen sie einen neuen Namen vergeben?", _
      "Dateiname")
    If strNewName <> "" Then
      strFileName = strPath & Left(strNewName, InStr(1, strNewName, ".xls") - 1) & ".xlsm"
    Else
      Exit Sub
    End If
  End If
  
  Sheets(cstrTabToCopy).Copy
  
  With ActiveWorkbook
    .SaveAs Filename:=strFileName, FileFormat:=52
    .Close
  End With
End If

End Sub

Beim Folder-Dialog muss man immer einen Ordner anklicken, sonst kommt die Fehlermeldung!
Einen neuen Ordner kann man direkt im Dialog über die Schaltfläche 'Neuer Ordner' anlegen.
Wenn die Datei schon vorhanden ist, öffnet sich ein Dialog, der zur Eingabe eines neuen Namens auffordert.
Gruß Sepp

Anzeige
Leider Fehlermeldung
22.12.2017 19:38:43
Sigrid
Hallo Sepp,
danke für das Schnelle.
Wie kann ich die Zeile ändern:
Const cstrTabToCopy As String = "ActiveSheet.Name" '"Sigrid" 'Tabelle die kopiert werden soll - Anpassen!
funktioniert nicht, es soll ja der Name der aktivenSheet übernommen werden.
Wenn der Name schon im Verzeichnis vorhanden ist, ich ändere diesen z.b. in weber, dann
wird eine Fehlermeldung ausgegeben:
"Laufzeitfehler 9
Ungültiger Prozeduraufruf oder ungültiges Argument"
mfg
sigrid
AW: Leider Fehlermeldung
22.12.2017 19:50:11
Sepp
Hallo Sigrid,
dann so.
' **********************************************************************
' Modul: Modul3 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub saveSheet()
Dim strPath As String, strFileName As String, strNewName As String
Dim strTabToCopy As String

strTabToCopy = ActiveSheet.Name 'Tabelle die kopiert werden soll - Anpassen!

With Application.FileDialog(msoFileDialogFolderPicker)
  .InitialFileName = ThisWorkbook.Path 'oder "C:\Sigrid"
  .Title = "Ordnerauswahl"
  .ButtonName = "Auswahl..."
  .InitialView = msoFileDialogViewList
  If .Show = -1 Then
    strPath = .SelectedItems(1)
    If Right(strPath, 1) <> "\" Then strPath = strPath & "\"
  End If
End With

If Len(strPath) Then
  strFileName = strPath & Sheets(strTabToCopy).Range("B2").Text & ".xlsm"
  Do
    If Dir(strFileName, vbNormal) <> "" Then
      strNewName = InputBox("Die Datei" & vbLf & "'" & strFileName & "'" & vbLf & _
        "ist bereits vorhanden!" & vbLf & vbLf & "Wollen sie einen neuen Namen vergeben?", _
        "Dateiname")
      If strNewName <> "" Then
        If InStr(1, strNewName, ".xls") > 0 Then strNewName = Left(strNewName, InStr(1, strNewName, ".xls") - 1)
        strFileName = strPath & strNewName & ".xlsm"
      Else
        Exit Sub
      End If
    End If
  Loop While Dir(strFileName, vbNormal) <> "" And strNewName <> ""
  
  Sheets(strTabToCopy).Copy
  
  With ActiveWorkbook
    .SaveAs Filename:=strFileName, FileFormat:=52
    .Close
  End With
End If

End Sub

Gruß Sepp

Anzeige
Super aber...
22.12.2017 20:06:56
Sigrid
Hallo Sepp,
keine Fehlermeldung.
Aber wie bekomme ich den neuen Namen, wenn also schon vorhanden, in die Zelle B2,
damit vor dem Speichern der Sheetname auch geändert ist.
Ich hatte dies eingesetzt:
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Application.EnableEvents = True
If Target.Address = "$B$2" Then
ActiveSheet.Name = ActiveSheet.Range("B2")
ActiveSheet.Range("B2").Select
End If
End Sub
gruß
sigrid
AW: Super aber...
22.12.2017 20:23:42
Sepp
Hallo Sigrid,
' **********************************************************************
' Modul: Modul3 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub saveSheet()
Dim strPath As String, strFileName As String, strNewName As String
Dim objTabToCopy As Object

Set objTabToCopy = ActiveSheet

With Application.FileDialog(msoFileDialogFolderPicker)
  .InitialFileName = ThisWorkbook.Path 'oder "C:\Sigrid"
  .Title = "Ordnerauswahl"
  .ButtonName = "Auswahl..."
  .InitialView = msoFileDialogViewList
  If .Show = -1 Then
    strPath = .SelectedItems(1)
    If Right(strPath, 1) <> "\" Then strPath = strPath & "\"
  End If
End With

If Len(strPath) Then
  strFileName = strPath & objTabToCopy.Range("B2").Text & ".xlsm"
  Do
    If Dir(strFileName, vbNormal) <> "" Then
      strNewName = InputBox("Die Datei" & vbLf & "'" & strFileName & "'" & vbLf & _
        "ist bereits vorhanden!" & vbLf & vbLf & "Wollen sie einen neuen Namen vergeben?", _
        "Dateiname")
      If strNewName <> "" Then
        If InStr(1, strNewName, ".xls") > 0 Then strNewName = Left(strNewName, InStr(1, strNewName, ".xls") - 1)
        strFileName = strPath & strNewName & ".xlsm"
      Else
        Exit Sub
      End If
    End If
  Loop While Dir(strFileName, vbNormal) <> "" And strNewName <> ""
  
  If strNewName <> objTabToCopy.Name Then
    Application.EnableEvents = False
    objTabToCopy.Name = strNewName
    objTabToCopy.Range("B2") = strNewName
    Application.EnableEvents = True
  End If
  
  objTabToCopy.Copy
  
  With ActiveWorkbook
    .SaveAs Filename:=strFileName, FileFormat:=52
    .Close
  End With
End If

End Sub

Gruß Sepp

Anzeige
Du hast es aber drauf !!! Danke
22.12.2017 20:37:33
Sigrid
Hallo Sepp,
SUPER herzlichen Dank !
Vielleicht kannst Du mir helfen !?
Habe mir vorhin ein Makro kopiert:
'---- hiermit werden Dateien aktiviert -----------
Private Sub lstOffeneMappen_Change()
Dim Sh As Object
Dim wb As Workbook
With lstOffeneMappen
Set wb = Application.Workbooks(.List(.ListIndex))
End With
lstBlätter.Clear
For Each Sh In wb.Sheets
lstBlätter.AddItem Sh.Name
Next Sh
lstBlätter.ListIndex = 0
'Sheets(lstBlätter.ListIndex + 1).Activate
wb.Activate
!!!!!!!!!!!Me.Label1 = ThisWorkbook.Sheets.Count
End Sub
Die Dateien werden in der Listbox eingelesen, wenn ich aber in der Listbox
eine Datei mit mehreren Sheet auswähle, wird die Anzahl nicht angezeigt.
Die Zeile steht auch in der

Private Sub UserForm_Initialize()
Weiß nicht warum !
gruß
sigrid

Anzeige
AW: Du hast es aber drauf !!! Danke
22.12.2017 20:40:24
Sepp
Hallo Sigrid,

Me.Label1 = wb.Sheets.Count
Gruß Sepp

Super Danke .... -)
22.12.2017 20:55:57
Sigrid
Hallo Sepp,
danke für die Unterstützung !
Ich wünsch Dir jetzt schon ein frohes Fest und
ein gesundes, erfolgreiches Jahr !!!
mfg
sigrid
Das wünsch ich Dir auch! o.T.
22.12.2017 20:59:28
Sepp
Gruß Sepp

AW: Tabelle als Datei speichern
22.12.2017 10:45:59
fcs
Hallo Sigrid,
etwa so. Als Verzeichnis für die zu speichernde Datei hab ich das Verzeichnis der Mappe mit dem Blatt "Sigrid" definiert - ggf. anpassen:
Sub CopySigrid()
Dim wkb As Workbook
Dim sPfad As String
If MsgBox("Blatt ""Sigrid"" kopieren?", vbQuestion + vbOKCancel, _
"Blatt ""Sigrid"" in neue Datei") = vbCancel Then Exit Sub
sPfad = ActiveWorkbook.Path & "\"   'Verzeichnis ggf. anpassen
ActiveWorkbook.Worksheets("Sigrid").Copy
Set wkb = ActiveWorkbook
wkb.SaveAs Filename:=sPfad & "Sigrid.xlsm", FileFormat:=52 '52= _
xlOpenXMLWorkbookMacroEnabled
End Sub

Gruß
Franz
Anzeige
Hallo Franz klappt ebenfalls ...
22.12.2017 11:02:19
Sigrid
Guten Morgen Franz,
DANKE.
Funktioniert ebenfalls.
Ich würde jedoch den aktuellen Sheet-Namen übernehmen.
Wenn die neue Datei vorhanden ist soll dieser Name geändert werden,
der Name der Sheet steht in Zelle B2.
gruß
sigrid

311 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige