xls in Format .txt per VBA konvertieren
Bernd
ich bitte um Eure geschätzte Hilfe.
Problem:
ich extrahiere aus einer Forecast-Datei per Makro ein einzelnes Tabellenblatt, das die Kosten je Konto und Periode für einen Upload zu SAP bereitstellt. Das Format ist xls. Jetzt benötigt SAP aber das Format "Text (Tabstopp getrennt)(.txt)". Bis dato muss ich das als xls gespeicherte Blatt wieder aufrufen und dann als txt speichern. Und diese Arbeit würde ich gerne automatisieren.
Nachstehend der Code für das Erzeugen der xls.-Datei und auch die Datei mit dem relevanten Blatt und Makro.
https://www.herber.de/bbs/user/67057.xls
Dim strFile As String, wbQuelle As Workbook, wbZiel As Workbook
Dim wksQuelle As Worksheet, wksZiel As Worksheet, zelle As Range
Dim iClick As Integer
strFile = Sheets("Upload-File Monatswerte").Range("C3") & " FC Kosten Upload Monatswerte" 'Dateinamen vorgeben!
strFile = Application.GetSaveAsFilename(InitialFileName:=strFile, _
fileFilter:="Excel Files (*.xls; *.xla; *.xlt), *.xls; *.xla; *.xlt")
If strFile = "Falsch" Then Exit Sub
Set wbQuelle = ActiveWorkbook 'Workbooks("Master FC mit Upload-Exportfunktion.xls") '
Set wksQuelle = wbQuelle.Sheets("Upload-File Monatswerte")
wksQuelle.Copy
Set wbZiel = ActiveWorkbook
Set wksZiel = wbZiel.Worksheets(1)
With wksZiel
'Alles Inhalte durch Werte ersetzen
.UsedRange.Value = .UsedRange.Value
'Spalten ab Spalte Q (18) löschen
.Range(.Columns(17), .Columns(.Columns.Count)).Delete Shift:=xlShiftToLeft
'Zeile 1 (Überschriften Exportdatei (nicht Ursprungsdatei !!) ) löschen
Rows("1:2").Select
Selection.Delete Shift:=xlUp
'anschließend in der Upload-Tabelle alles ab Zeile 36 löschen
.Range(.Rows(36), .Rows(.Rows.Count)).Delete Shift:=xlShiftUp
'Makrobutton, Textbox und Summenwerte löschen
ActiveSheet.Shapes("Button 1").Select
Selection.Delete
Range("P37").Select
Selection.AutoFill Destination:=Range("P37:P40"), Type:=xlFillDefault
Range("A1").Select
'Name ändern
.Name = "Upload-Datei Kosten"
'Alle Zahlen im Upload-Bereich auf 2 Stellen runden
For Each zelle In .Range("A1:P35")
If IsNumeric(zelle) Then
zelle.Value = Application.WorksheetFunction.Round(zelle.Value, 2)
End If
Next
End With
'Konto mit der führenden Null versehen
Range("D35").Select
ActiveCell.FormulaR1C1 = "'08990000"
Range("E1").Select
With wbZiel
.SaveAs strFile
.Close 'wenn die neue Mappe geschlossen werden soll!
End With
Call Upload_File_Mitarbeiter
End Sub
Danke Euch im voraus
Grüße, Bernd