Datenbereich mit VBA in CSV exportiieren

Hallo,
ich möchte mit dem Makro siehe unten Daten aus einem Datenbereich "C4:H30", "S4:U300" alle Zeilen als CSV-Datei exportieren,
welche in Bereich AJ4:AJ300 den Wert "exportieren_TEL" enthalten. Diese Status Zellen enthalten aber auch noch ander Statuswerte.
Nun bekomme ich aber immer eine Fehlermeldung
Fehler beim Kompilieren:


Sub oder 

Function nicht definiert  --> welches sich auf den Makroinhalt "ExportRangeAsCSV" siehe ganz unten bezieht (ist blau markiert)
Kann mir bitte jemand daraus ein lauffähiges Makro machen.
Danke!

Sub ExportCSV()
Dim ws As Worksheet, fd As FileDialog, rngTest As Range, rngExport As Range, fltr As FileDialogFilter
'Worksheet auf dem die Daten stehen
Set ws = Kunden
'Zelle die auf Inhalt überprüft werden soll
Set rngTest = ws.Range("AJ4:AJ300")
'Bereich der exportiert wird
Set rngExport = ws.Range("C4:H30", "S4:U300")
If rngTest.Text = "exportieren_TEL" Then
Set fd = Application.FileDialog(msoFileDialogSaveAs)
With fd
.Title = "exportieren_TEL_Daten"
'Filterindex für CSV-Dateien ermitteln
For i = 1 To .Filters.Count
If .Filters(i).Extensions = "vis_order.csv" Then
.FilterIndex = i
Exit For
End If
Next
'Wenn OK geklickt wurde starte Export
If .Show = True Then
ExportRangeAsCSV rngExport, ";", .SelectedItems(1)
End If
End With
End If
End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub ExportCSV() Dim ws As Worksheet, fd As FileDialog, rngTest As Range, rng As Range, fltr As FileDialogFilter Dim i As Long, line As String Dim csvContent As String, fso As Object, csvFile As Object Sheets("Kunden").Unprotect ' Blattschutz aufheben Set fd = Application.FileDialog(msoFileDialogSaveAs) With fd .Title = "exportieren_TEL_Daten" 'Filterindex für CSV-Dateien ermitteln For i = 1 To .Filters.Count If .Filters(i).Extensions = "vis_order.csv" Then .FilterIndex = i Exit For End If Next End With 'Wenn OK geklickt wurde starte Export If fd.Show = True Then Set fso = CreateObject("Scripting.FileSystemObject") Set csvFile = fso.OpenTextFile(fd.SelectedItems(1), 2, True) 'Worksheet auf dem die Daten stehen Set ws = Worksheets("Kunden") For Each rngTest In ws.Range("AJ5:AJ30").Cells 'Anzahl der zu prüfenden Zeilen festlegen If rngTest.Text Like "*exportieren_TEL*" Then i = rngTest.Row line = "" For Each rng In ws.Range("C" & i & ":H" & i & "," & "S" & i & ":U" & i) ' C:H, S:U line = line & "" & rng.Value & "" & ";" Next csvContent = csvContent & Left(line, Len(line) - 1) & vbNewLine End If Next If csvContent = "" Then MsgBox "Keine Daten gefunden": Exit Sub csvFile.Write (csvContent) csvFile.Close End If 'Blattschutz im Register Kunde aktivieren beim Speichern der Datei Sheets("Kunden").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _ , AllowFormattingCells:=True, AllowFormattingColumns:=True, _ AllowFormattingRows:=True, AllowFiltering:=True End Sub

Zitat: Perfekt, danke Ralf! Gerne, das reicht nun aber auch. Funktionalitäten nachbestellen ist kein schöner Zug. Du wusstest doch schon vorher was du haben willst und was nicht. 1 die Überschriften aus Zeile 3 mit exportiert werden -schwierig 2 Dateipfad und Dateiname zum speichern mitgegeben werden und als MsgBox angezeigt werden 2.1 C:\Users\Simon\Documents\Privat\Sonstiges\Albert und Export_Tel_Daten.csv - siehe hier: https://www.herber.de/forum/archiv/1372to1376/1372286_Speichern_Unter.html Wenn du den Dateinamen im Dialog auswählst, kann der Pfad schon vorgegeben werden. Soll das wegfallen und nur eine MsgBox für das Ende des Exports gezeigt werden? 3. Kann die Schleife ev. nur so oft durchlaufen werden als Daten zum exportieren lt. Status "exportieren_TEL" vorhanden sind? Warum? Die Schleife muß über alle Zeilen laufen, um dann den Zellwert auf den Textinhalt zu prüfen. Wenn die Suchfunktion auf eine andere Vba-Routine umgebaut werden soll, dann habe ich meine Zeit für Nothing investiert.

Entschuldige Ralf, ich wollte dich in keinster Weise verärgern, und ich bin so froh, dass du mir das gemacht hast.
Es ist auf keinen Fall für "nichts gewesen", weil ich dein Makro sowieso verwenden werde. Es ist genau das was ich brauche.
Bzgl. Funktionalitäten nachbestellen bin ich erst auf Grund des Ergebnisses auf die Ideen gekommen, dass
die nachgereichten Punkt schön wären, wenn diese auch noch möglich wäre.
zu 2: Das mit Dateipfad und Dateiname lassen wir so, wie es von dir gelöst ist. Es wird ja nicht so oft exportiert und daher nicht so wichtig.
Z.I. Das Makro lt deinem Link bekomme ichtrotz Anpassungen nicht zum laufen: https://www.herber.de/forum/archiv/1372to1376/1372286_Speichern_Unter.html
zu 3: Wegen der Schleife habe ich als unwissender gefragt, weil mir beim durchlaufen im Einzelschrittmodus aufgefallen ist, dass
das Makro halt oft die Schleife macht. Ich hatte als Laie keine Ahnung, dass dadurch alles umzubauen wäre. Das lassen wir natürlich auch so wie es ist.
Darf ich trotz der Verärgerung die ich ausgelöst habe, bitte noch Fragen, ob du mir folgendes noch realisieren könntes, wenn es technisch möglich ist:
1 Die Überschriften aus Zeile 3 mit exportieren, falls dies mit vertretbaren Aufwand für dich lösbar ist.
Wenn das nicht möglich ist, dann schreibe ich vor dem Aufruf des Makros in die Überschriftenzeile in Zelle "AJ3" = exportieren_TEL hinein und
ändere den Bereich im Makro auf AJ3 --> For Each rngTest In ws.Range("AJ3:AJ30"). Das habe ich getestet und funktioniert.
2 Ja, eine MsgBox für das Ende des Exports wäre schön wenn das angezeigt wird.
Danke nochmals für deine Tolle und perfekte Unterstützung.
FG
Albert

Sub ExportCSV() Dim ws As Worksheet, fd As FileDialog, rngTest As Range, rng As Range, fltr As FileDialogFilter Dim i As Long, lRow As Long, lLastRow As Long, line As String Dim csvContent As String, fso As Object, csvFile As Object Dim strFilePath As String strFilePath = "F:\test\Albert und Export_Tel_Daten.csv" 'anpassen 'C:\Users\Simon\Documents\Privat\Sonstiges\Albert und Export_Tel_Daten.csv Sheets("Kunden").Unprotect If Dir(strFilePath) "" Then Kill strFilePath 'datei löschen wenn vorhanden Set fso = CreateObject("Scripting.FileSystemObject") Set csvFile = fso.OpenTextFile(strFilePath, 2, True) 'Worksheet auf dem die Daten stehen Set ws = Worksheets("Kunden") lLastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row 'letzte belegte Zeile in Spalte A For lRow = 3 To lLastRow If ws.Cells(lRow, "AJ").Text Like "*exportieren_TEL*" Or lRow = 3 Then line = "" For Each rng In ws.Range("C" & lRow & ":H" & lRow & "," & "S" & lRow & ":U" & lRow) ' C:H, S:U line = line & "" & rng.Value & "" & ";" Next csvContent = csvContent & Left(line, Len(line) - 1) & vbNewLine End If Next If csvContent = "" Then MsgBox "Keine Daten gefunden": Exit Sub csvFile.Write (csvContent) csvFile.Close If Err = 0 Then MsgBox "Datei erstellt" & vbLf & strFilePath, vbInformation, "CSV - Export" 'Blattschutz im Register Kunde aktivieren beim Speichern der Datei Sheets("Kunden").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _ , AllowFormattingCells:=True, AllowFormattingColumns:=True, _ AllowFormattingRows:=True, AllowFiltering:=True End Sub

strFilePath = "F:\test\Albert und Export_Tel_Daten_" & Format(Date, "dd_mm_YYYY") & ".csv" 'anpassen Next ws.Cells(lRow, "AM") = Date csvContent = csvContent & Left(line, Len(line) - 1) & vbNewLine

Beliebteste Forumthreads (12 Monate)

Datenbereich mit VBA in CSV exportiieren

20
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

309 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Datenbereich mit VBA in CSV exportiieren

20 Beiträge zum Forumthread Beiträge zu diesem Forumthread

309 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

20
Beiträge zum Forumthread

Beiträge zu diesem Forumthread