Hallo,
ich habe Probleme mit einem Makro das ich geschrieben habe. Es erstellt aus meiner Dienstplantabelle heraus eine CSV-Datei. Nun möchte ich das diese Datei im gleichen Ordner wie die Ursprungsdatei gespeichert wird. Da die Dienstplatabelle einige Kollegen nutzen die die Tabelle an unterschiedlichen Orten und unter unterschiedlichen Namen speichern, kann ich dem Makro keine vordefinierten Daten liefern. Ich hatte nämlich einige Lösungen im Internet gefunden, welche sich aber entweder auf einen festen Pfad oder auf einen festen Tabellennamen beziehen. Nun brauche ich also einen Vorgang wodurch Excel sich den Pfad der aktiven Tabelle merkt bevor die neue Tabelle erstellt wird und ihn dann als Speicherort verwendet. Auch wenn das nicht soviel hilft habe ich mal das Makro beigefügt. Die Tabelle ist leider zu groß um sie hier hochzuladen.
Vielen Dank für eure Hilfe!
Paul.
Sub CSV()
Application.ScreenUpdating = False
ActiveWorkbook.Unprotect "123"
Sheets("Export").Select
Sheets("ExportCSV").Visible = True
Sheets("ExportCSV").Unprotect Password:="123"
Sheets("Data5").Visible = True
Sheets("Data5").Unprotect Password:="123"
Sheets("Data5").Select
Range(Sheets("Export").Range("S3")).Copy
Range("A1").Select
Sheets("ExportCSV").Select
Range("B2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveWorkbook.Worksheets("ExportCSV").ListObjects("Tabelle2").Sort.SortFields. _
Clear
ActiveWorkbook.Worksheets("ExportCSV").ListObjects("Tabelle2").Sort.SortFields. _
Add Key:=Range("Tabelle2[[#All],[Start Date]]"), SortOn:=xlSortOnValues, _
Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("ExportCSV").ListObjects("Tabelle2").Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Sheets("Data5").Visible = False
Sheets("ExportCSV").Select
Sheets("ExportCSV").Copy
ActiveWorkbook.Date1904 = True
ChDir ThisWorkbook.Path
ActiveWorkbook.SaveAs Filename:=Range("A2").Value, _
FileFormat:=xlCSV, CreateBackup:=False
ActiveWorkbook.Save
ActiveWindow.Close
Sheets("ExportCSV").Select
Sheets("ExportCSV").Visible = False
Sheets("Export").Select
ActiveWorkbook.Protect Password:="123", _
Structure:=True, Windows:=False
Application.ScreenUpdating = True
End Sub