313 Aufrufe
Gefragt in Tabellenkalkulation von oxmoks Einsteiger_in (3 Punkte)
Hallo zusammen,

bin recht frisch mit VBA und eventuell hat jemand etwas Hilfestellung für mich.

ich möchte eine bestimmtes Arbeitsblatt mit dem Titel "KHT Protokoll" mit einem Makro als .xls speichern.

Speicherort soll "C:\Users\oxmok\Desktop\Micha\" sein. funktionieren tut dies nur leider nicht.

kann mir jemand helfen??

folgendes habe ich mir überlegt:

Sub KHT_ALS_XLS_SPEICHERN()

Dim strPath As String
Application.ScreenUpdating = False
ChDrive "C:\"
' Pfad fest vorgeben
ChDir "C:\Users\oxmok\Desktop\Micha\"
' Pfad aus Zelle C1
'ChDir Sheets("Tabelle1").Range("C1").Value
Sheets("KHT PSA Prüfprotokoll").Copy
strPath = Application.GetSaveAsFilename(InitialFileName:=Sheets("KHT PSA Prüfprotokoll").Range("H9").Value & ".xls", FileFilter:="Exceldateien  (*.xls),*.xls,Alle Dateien (*.*), *.*")
    If strPath = "False" Or strPath = "Falsch" Then Exit Sub
ActiveWorkbook.SaveAs strPath
ActiveWorkbook.Close
Application.ScreenUpdating = True

End Sub

schon im vorraus danke

2 Antworten

0 Punkte
Beantwortet von finger59 Experte (1.3k Punkte)
Hi, wenn ich Dich richtig verstehe hast Du immer die gleiche Tabellenblattbezeichnung und den gleichen Pfad und wenn das Tabellenblatt ohne Makros abgelegt werden soll, so kannst Du das Ganze mit dem Makrorecorder aufzeichnen. Aus meiner Sicht sollte das damit auch funktionieren.

MfG... Helmut
0 Punkte
Beantwortet von finger59 Experte (1.3k Punkte)
Hi, ich habe das mal mit einer Testmappe mit dem Makrorecorder bei mir nachgebaut und ein paar kleinere Befehle manuell hinzugefügt...

In der Hoffnung das Die dieses mehr bringt, wie meine Aussage den Rekorder dazu zu nutzen verbleibe ich mit freundlichen Grüßen... Helmut

Sub KHTkopieren()
'
' KHTkopieren Makro
'***  hierdurch wird der Bildschirm sozusagen ausgeschaltet
Application.ScreenUpdating = False  

'*** Abfragen werden unterdrückt (hier ob man die vorhandene Datei wirklich überschreiben möchte
Application.DisplayAlerts = False  

'****Tabellenblatt KHT PSA Prüfprotokoll auswählen und kopieren
    Sheets("KHT PSA Prüfprotokoll").Select
    Sheets("KHT PSA Prüfprotokoll").Copy
'**** Dieses dann als xls auf dem Desktop in Deinem Pfad speichern

   ActiveWorkbook.SaveAs Filename:= _
        "C:\Users\oxmok\Desktop\Micha\\KHT PSA Prüfprotokoll.xls", FileFormat:= _
        xlExcel8, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
        , CreateBackup:=False
'****  Nach dem Kopiervorgang wird die Datei dann geschlossen  

  ActiveWorkbook.Close

'***  Die Fehlermeldungen und der Bildschirm wird wieder aktiviert

Application.DisplayAlerts = True
Application.ScreenUpdating = True
'*****   Du stehst wieder in der Datei, wo du zuletzt warst       
End Sub
...