Hallo,
da ich VBA nur über den Makro-Rekorder kann, habe ich mir eine Code zum Datenexport aus Excel in eine CSV aus dem Internet kopiert und angepasst.
Aber ich bekomme es nicht hin, das an bestimmten Stellen die Adressen/Bereiche über den Namensmanager kommen.
Wie muss ich die Passagen umbauen, damit es funktioniert.
Die betroffenen Passagen habe ich wie folgt gekennzeichnet.
'**************************************************************
Code
'**************************************************************
BS: Windows 10 Home
Office: Office 365
Bitte um Hilfe!
Danke!
Sub ExportCSV_TEL_Kontaktdaten()
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
'Speicherpfad und Dateiname incl. Zeitstempel
strFilePath = "C:UsersSimonDocumentsPrivatSonstigesAlbertCSV ExportdateienExport_Tel_Daten_" & Format(Now, "YYYY.MM.DD - HH.MM") & ".csv" 'Format(Date, "yyyy.mm.dd) 'Format(DateTime, "yyyy.mm.dd_hh:nn") & ".xlsm" "yyyy.mm.dd-hhnn" "yyyy-mm-dd hh:nn:ss"
' Blattschutz aufheben
Sheets("Kunden").Unprotect
'datei löschen wenn vorhanden
If Dir(strFilePath) <> "" Then Kill strFilePath
Set fso = CreateObject("Scripting.FileSystemObject")
Set csvFile = fso.OpenTextFile(strFilePath, 2, True)
'Worksheet auf dem die Daten stehen
Set ws = Worksheets("Kunden")
'letzte belegte Zeile in Spalte A
lLastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
For lRow = 3 To lLastRow
' Exportieren wenn in Spalte AJ "*exportieren_TEL*" enthält und Zeile 3 für die Überschriften
'**************************************************************
If ws.Cells(lRow, "AJ").Text Like "*exportieren_TEL*" Or lRow = 3 Then
'NEU Anstelle "AJ" soll der Name lt. Namensmanager "Status_Kunden" stehen mit Bezug =Kunden!$AJ$5:$AJ$10004
'**************************************************************
line = ""
'Exportbereich C:G + M:P + R:AE
'**************************************************************
For Each rng In ws.Range("C" & lRow & ":G" & lRow & "," & "M" & lRow & ":P" & lRow & "," & "R" & lRow & ":AE" & lRow)
line = line & "" & rng.Value & "" & ";"
''NEU Anstelle "C" bis "G" & "M" bis "P" & "R" bis "AE" soll der Name lt. Namensmanager "CSVExport_TEL" stehen mit Bezug =Kunden!$C:$G;Kunden!$M:$P;Kunden!$R:$AE
'**************************************************************
Next
'Exportdatum für exportierte Datensätze ab Zeile 4 in Spalte AM schreiben
'**************************************************************
If lRow > 3 Then ws.Cells(lRow, "AM") = Date
'NEU Anstelle "AM" soll der Name lt. Namensmanager "CSVExportdatum_TEL" stehen mit Bezug =Kunden!$AM$4:$AM$10004
'**************************************************************
'Daten für CSV-Inhalt erstellen
csvContent = csvContent & Left(line, Len(line) - 1) & vbNewLine
End If
Next
' In Spalte AJ den Wert "exportieren_TEL" mit dem Wert "Bereits_exportiert_TEL" ersetzen
Columns("AJ").Replace What:="exportieren_TEL", Replacement:="Bereits_exportiert_TEL", LookAt:= _
xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
'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
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"
End Sub
|