AW: VBA für jede Zeile einzelne Textdatei erzeugen
30.03.2017 08:23:58
Stefanie
Oh ja sorry, dass habe ich total vergessen ..
Also in der oberen Datei werden genau die Spalten ausgegeben, die ich benötige, das funktioniert und im unteren Teil wird bei jedem SChleifendurchlauf eine Textdatei erzeugt, ich habe hier nur 3 angegeben aber eigentlich soll für jede Zeile eine erzeugt werden.
Ganz unten habe ich versucht die beiden Codes miteinander zu verknüpfen, aber es funktioniert nicht ..
Was kann ich an dem Code verbessern oder anders machen ?
Liebe Grüße :*
'**********************************Gibt die richtigen Spalten aus ************************************************
Sub imaSchnittstelle()
'Variablen deklarieren
Dim i As Long
Dim Pfad As String
Dim TD As Integer
Dim sLine As Variant
Application.DisplayAlerts = False 'Bildschirmaktualisierungen ausschalten, Makro wird schneller _
ausgeführt und Bildschirm flackert nicht
lz = Sheets("KFL_allePrgr_23032017").UsedRange.SpecialCells(xlCellTypeLastCell).Row 'ermittelt _
die letzte Zeile des Tabellenblattes
Pfad = "C:\Desktop\Test.txt" 'Hier wird die Datei gespeichert: kann geändert werden
TD = FreeFile() 'gibt Wert von Typ Integer zurück, der nächste verfügbare Dateinummer darstellt
'Öffnet die Datei zum reinschreiben
Open Pfad For Output As TD 'kann auch Append benutzt werden: Output überschreibt vorhandene _
Datei & Append fügt neue Zeile hinzu
'Schleife: Anweisung wird von Zeile 9 bis zur letzten Zeile durchgeführt
For i = 9 To lz
Print #TD, Cells(i, 1) & ";" & Cells(i, 10) & ";" & Cells(i, 10) & ";" & Cells(i, 18) & ";" & _
Cells(i, 17) & ";" & Cells(i, 5) & ";" & Cells(i, 9) & ";" & Cells(i, 16) & ";" & Cells(i, 11) & ";" & Cells(i, 20) & ";" & Cells(i, 21)
Next i 'nächste Zeile
Application.DisplayAlerts = True 'Bildschirmaktualisierungen wieder einschalten
MsgBox "Die Textdateien wurden im Verzeichnis ... gespeichert !" 'Benachrichtigungsfenster am _
Ende des Makros
End Sub
'**********************************Erstellt bei jedem Schleifendurchlauf eine Textdatei******************************************
Sub WorksheetsErstellenSchleife()
'Datei erstellen
Dim i As Integer
Dim Pfad As String
Pfad = "C:\Desktop"
For i = 1 To 3
Workbooks.Add
With ActiveWorkbook
.SaveAs Pfad & "Test" & i & ".txt"
'.Worksheets("Tabelle1").Cells(1, 1).Value = "Test"
.Close True
End With
Next
End Sub
__________________________________
Sub imaSchnittstelle()
'Variablen deklarieren
Dim i As Long
Dim Pfad As String
Dim TD As Integer
Dim sLine As Variant
Dim m As Integer
Application.DisplayAlerts = False 'Bildschirmaktualisierungen ausschalten, Makro wird schneller _
ausgeführt und Bildschirm flackert nicht
lz = Sheets("KFL_allePrgr_23032017").UsedRange.SpecialCells(xlCellTypeLastCell).Row 'ermittelt _
die letzte Zeile des Tabellenblattes
Pfad = "C:\Desktop\Test.txt" 'Hier wird die Datei gespeichert: kann geändert werden
TD = FreeFile()
'Öffnet die Datei zum reinschreiben
Open Pfad For Output As TD 'kann auch Append benutzt werden: Output überschreibt vorhandene _
Datei & Append fügt neue Zeile hinzu
'Schleife: Anweisung wird von Zeile 9 bis zur letzten Zeile durchgeführt
For i = 9 To lz
Workbooks.Add
With ActiveWorkbook
.SaveAs Pfad & "TestTest" & i & ".txt"
.Worksheets("KFL_allePrgr_23032017").Cells(1, 1).Value = "Test"
.Close False
Print #TD, Cells(i, 1) & ";" & Cells(i, 10) & ";" & Cells(i, 10) & ";" & Cells(i, 18) & ";" & _
Cells(i, 17) & ";" & Cells(i, 5) & ";" & Cells(i, 9) & ";" & Cells(i, 16) & ";" & Cells(i, 11) & ";" & Cells(i, 20) & ";" & Cells(i, 21)
Next i 'nächste Zeile
Application.DisplayAlerts = True 'Bildschirmaktualisierungen wieder einschalten
MsgBox "Die Textdateien wurden im Verzeichnis ... gespeichert !" 'Benachrichtigungsfenster am _
Ende des Makros
End Sub