Frage Code-Änderung
10.02.2016 20:22:35
Guesa
Dank Eurer Hilfe habe ich meine Arbeitsdatei vollenden können und läuft wunderbar. Im täglichen Gebrauch gefällt mir eine Sache nicht so ganz, da sich alle abgespeicherten Dateien in einem Ordner befinden, ist halt recht unübersichtlich. Könnte mir jemand folgenden Code so umschreiben, oder zumindest einen Tip geben, dass aus Zelle P1 ein Ordner einmalig erstellt wird, der dann auch bei nachfolgenden Dateien erkannt wird das es diesen bereits gibt, dieser ist jetzt festgeschrieben, aus P2 soll dann der Dateiname (ist ja jetzt auch) erstellt werden. Es braucht auch keine Meldung erscheinen, das dieser Ordner bereits vorhanden ist. Ich hoffe das ich mich einigermaßen verständlich ausgedrückt habe. Hier mein bisheriger Code und schon mal ein Dankeschön für die Hilfe.
Sub Speichern()
Dim wb As Workbook
Dim strFileName As String
On Error GoTo ErrorHandler
Application.DisplayAlerts = False
With ThisWorkbook.Worksheets("BerStempel")
strFileName = .Range("P1") & "\" & .Range("P2") & ".xlsx"
'strFileName = .Range("B1") & "\" & .Range("C1") & ".xls"
End With
ActiveSheet.Copy
With ActiveWorkbook
.SaveAs strFileName, FileFormat:=51
'Oder als xls
'.SaveAs strFileName, FileFormat:=-4143
.Sheets(1).Shapes("speichern1").Delete
.Close True
End With
ErrorHandler:
If Err.Number > 0 Then MsgBox Err.Description, , "Fehler: " & Err.Number
Application.DisplayAlerts = True
Call Rech_Nr
End Sub