VBA Tabellenblatt in txt und xlsx automatisch speichern

Lad Dir mal das AddIn runter.
<br />https://www.dropbox.com/s/m7qdh5gs3wqb99r/CSV.xla?dl=1
<br />Speicher es irgendwo ab und öffne es.
<br />Dann öffnest Du Deine Datei.
<br />Klick mit Rechts auf eine Zelle, das CSV Menü ist ganz unten, in den Optionen stellst Du das Format ein.



<br />Jetzt gehst Du in den VBA Editor
<br />Extras \ Verweise und da setzt Du einen Haken bei "AddIn_CSV":
<br />


<br />In ein reguläres Modul diesen Code
<br />Sub Test()
Dim FName As String
With Application.FileDialog(msoFileDialogSaveAs)
.FilterIndex = 12
.InitialFileName = Environ$("UserProfile") & "\Documents\Mein Dateiname.txt"
.ButtonName = "Abspeichern"
If Not .Show Then Exit Sub
FName = .SelectedItems(1)
End With
CSVExport FName, Intersect(Range("A1").CurrentRegion, Range("A:E"))
End Sub

<br />Wenn das läuft, dann kopierst Du das ganze und rufst statt CSVExport den Part auf:
<br /> 'Kopie des Blattes als neue Datei
ActiveSheet.Copy
'Fehler aus
Application.DisplayAlerts = False
'Abspeichern
ActiveWorkbook.SaveAs "Z:\test.xlsx", xlOpenXMLWorkbook
'Fehler an
Application.DisplayAlerts = True
<br />Der FilterIndex = 1 ist für xlsx Dateien.
<br />Andreas.
<br />

Hallo Andreas,
<br />vielen Dank für deine schnelle Antwort.
<br />hat leider nicht geklappt.
<br />wenn ich deine Datei öffne und dann meine und anschließend mit rechts auf eine Zelle klicke, kommt die CSV option garnicht.
<br />Für die Text Datei habe ich tatsächlich schon ein Code geschrieben die ich anwenden kann.
<br />Sub ascii_datei_exportieren()
<br />Close #1
<br />'Benutzer wählt Pfad und Name aus
<br /> Dim Fullpath As Variant
<br /> Fullpath = Application.GetSaveAsFilename(FileFilter:="Text-Dateien (*.txt),*.txt")
<br />
<br />'Öffnen der Textdatei
<br />Open Fullpath For Output As 1
<br />
<br />'Schleife für Zeilen
<br />For zeile = 1 To 1000000
<br />If Cells(zeile, 1) = "" Then Exit For
<br /> Text = ""
<br /> 'Schleife für Spalten
<br /> For spalte = 1 To 5
<br /> Text = Text & CVar(Cells(zeile, spalte))
<br /> If spalte < 5 Then Text = Text & "|" 'Trennzeichen = |
<br /> Next
<br /> Print #1, Text
<br />Next
<br />Close #1
<br />'Schließen der Textdatei
<br />
<br />End Sub
<br />Mir fehlt jetzt nur noch ein separaten Code für die Speicherung des Tabellenblattes als Excel auf ein bestimmten Pfad aber wo ich den Namen der Datei immer Manuell eingebe. Noch besser wäre es wenn die Datei erkennen würde das es schon Dateien Namen "1, 2, 3" im Ordner drin sind und sich selbst dann mit der nächsten zahl einspeichern würde.
<br />Meinst du dies wäre möglich?
<br />

Also, wenn Du ein AddIn öffnest und es nicht funktioniert, dann wird die Ausführung des Codes von Deinem System unterdrückt. Wahrscheinlich ist die Datei einfach geblockt.
<br />Unblock File in Windows 10 | Tutorials
<br />Oder Du hast die Datei an einem Ort der nicht durch Deine Sicherheitseinstellungen abgedeckt ist. Oder diese unterbinden die Ausführung generell ....
<br />Wie auch immer, Du kann Deinen Code verwenden, aber das gibt früher oder später Murks.
Schau Dir meinen (im AddIn) an, es gehört schon etwas mehr dazu.
<br />Und wie man ein Blatt separiert und als XLSX abspeichert hatte ich schon gezeigt:
<br /> 'Kopie des Blattes als neue Datei
<br /> ActiveSheet.Copy
<br /> 'Fehler aus
<br /> Application.DisplayAlerts = False
<br /> 'Abspeichern
<br /> ActiveWorkbook.SaveAs "Z:\test.xlsx", xlOpenXMLWorkbook
<br /> 'Fehler an
<br /> Application.DisplayAlerts = True
<br />Und eine automatische "Weiternummerierung" ... klar kann man alles machen, häng einfach eine fortlaufende Nummer an den Dateinamen an und kuck ob er existiert.
<br /> Dim i As Long
If Dir(Fullpath) <> "" Then
i = 1
Do While Dir(Fullpath & i) <> ""
i = i + 1
Loop
Fullpath = Fullpath & i
End If

<br />Andreas.
<br />

Der Code mit der fortlaufenden Nummer funktioniert in Kombination mit Deinem so nicht... weil der FullPath enthält auch die Dateiendung, Entschuldigung.
<br />Der Code unten macht einen neuen Namen wie der Windows-Explorer.
<br />Andreas.
<br />Function NewFileName(ByVal FullName As String) As String
'Return a filename that did not exists but begins with fullname
' i.E.: c:\temp\test.xla => c:\temp\test(1).xla
Dim i As Long, LeftParen As Long, RightParen As Long, DotPos As Long
Dim LeftPart As String, RightPart As String
If Dir$(FullName) <> "" Then
LeftParen = InStrRev(FullName, "(")
RightParen = InStrRev(FullName, ")")
On Error GoTo AddParen
i = Mid$(FullName, LeftParen + 1, RightParen - LeftParen - 1)
LeftPart = Left$(FullName, LeftParen)
RightPart = Mid$(FullName, RightParen)
GoTo Doit
AddParen:
DotPos = InStrRev(FullName, ".")
If DotPos = 0 Then
LeftPart = FullName & "("
RightPart = ")"
Else
LeftPart = Left$(FullName, DotPos - 1) & "("
RightPart = ")" & Mid$(FullName, DotPos)
End If
Doit:
Do
i = i + 1
NewFileName = LeftPart & i & RightPart
Loop Until Dir$(NewFileName) = ""
Else
NewFileName = FullName
End If
End Function

<br />

Hallo,

ich kann das nicht nachvollziehen. Da das Tabellenblatt mit seinem Namen referenziert wird, ist es egal an welcher Stelle es sich befindet.

Ist die Berechnung auf "Automatisch" gestellt? Hast du die Formeln von Hand eingegeben oder mit VBA? Wenn mit VBA, hast du dann das Tabellenblatt mit Namen oder mit Nummer referenziert? Ist das nur in dieser Mappe so oder generell in allen Mappen?

Claus