Bereiche als CSV exportieren

Hallo Zusammen,
ich habe da mal wieder ein Problem.

Ich muss aus einer Excel Datei aus 3 verschiedenen Spalten Daten (ohne Leerzeilen) in eine csv Datei exportieren.
Die Inhalte sind durch Semikolon zu trennen und haben am Anfang und am ende ein Ausrufezeichen.
Die weitere Schwierigkeit ist, dass ich aus zwei Spalten die Informationen zusammenführen muss und
in den letzten beiden Spalten die Anzahl der Artikel mit Semikolon auffüllen muss.

Die komplette Datei soll mit den übertragenen Informationen dann als CSV im UTF-8 exportiert werden mit dem Namen aus A2.

Anbei sende ich Euch die Beispieldatei. Vielen Dank schon einmal im Voraus.

https://www.herber.de/bbs/user/159300.xlsx

Beste Grüße
Hinnerk

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Option Explicit Sub Exporten() Dim LR As Integer, i As Integer Dim TB1 As Worksheet, TB2 As Worksheet Dim SRV As String, Mng As String, LTxt As String, STxt As String Dim Pfad As String, Datei As String, Ext As String Set TB1 = Sheets("export") Set TB2 = Sheets("csv_datei") Pfad = "E:\Excel\Temp\" 'mit \ am Ende Ext = ".csv" 'reset TB2.Range("I2:L2").ClearContents With TB1 LR = .Cells(.Rows.Count, "C").End(xlUp).Row 'letzte Zeile der Spalte For i = 2 To LR If .Cells(i, 3) > "" Then SRV = SRV & ";" & .Cells(i, 3) Mng = Mng & ";" & .Cells(i, 14) & "*" & .Cells(i, 7) LTxt = LTxt & ";" STxt = STxt & ";" End If Next End With With TB2 Datei = .Cells(2, 1) .Cells(2, 9) = """" & Mid(SRV, 2) & """" 'erste Semi wird weggelassen .Cells(2, 10) = """" & Mid(Mng, 2) & """" .Cells(2, 11) = LTxt .Cells(2, 12) = STxt End With ActiveWorkbook.SaveAs Filename:=Pfad & Datei & Ext, FileFormat:=xlCSVMSDOS, Local:=True End Sub

mit deiner Ergänzung Wenn der Faktor leer oder 0 ist, dann wird nur die Menge übernommen, ansonsten die Formel: Menge * Faktor.
und ohne ""

Option Explicit

Sub Exporten()
    Dim LR As Integer, i As Integer
    Dim TB1 As Worksheet, TB2 As Worksheet
    Dim SRV As String, Mng As String, LTxt As String, STxt As String
    Dim Pfad As String, Datei As String, Ext As String
    
    Set TB1 = Sheets("export")
    Set TB2 = Sheets("csv_datei")
    
    Pfad = "E:\Excel\Temp\" 'mit \ am Ende
    Ext = ".csv"
    
    'reset
    TB2.Range("I2:L2").ClearContents
    
    With TB1
        LR = .Cells(.Rows.Count, "C").End(xlUp).Row 'letzte Zeile der Spalte
        
        For i = 2 To LR
            If .Cells(i, 3) > "" Then
                SRV = SRV & ";" & .Cells(i, 3)
                Select Case .Cells(i, 7)
                    Case "", 0, 1
                        Mng = Mng & ";" & .Cells(i, 14)
                    Case Else
                        Mng = Mng & ";" & .Cells(i, 14) & "*" & .Cells(i, 7)
                
                End Select
                
                LTxt = LTxt & ";" '& ????
                STxt = STxt & ";" '& ????
                
            End If
        Next
        
        
    End With
    With TB2
        Datei = .Cells(2, 1)
        
        .Cells(2, 9) = Mid(SRV, 2)    'erste Semi wird weggelassen
        .Cells(2, 10) = Mid(Mng, 2)
    
        .Cells(2, 11) = LTxt
        .Cells(2, 12) = STxt
        
        'Blatt auswählen, nur das Aktive wird exportiert
        .Activate
    
    End With
    
    Application.DisplayAlerts = False ' "Schon vorhanden" abschalten
    ActiveWorkbook.SaveAs Filename:=Pfad & Datei & Ext, FileFormat:=xlCSVMSDOS, Local:=True
    Application.DisplayAlerts = True
End Sub

LG UweD

Option Explicit Sub Exporten() Dim LR As Integer, i As Integer, Z1 As Integer Dim TB1 As Worksheet, TB2 As Worksheet Dim SRV As String, Mng As String, LTxt As String, STxt As String Dim Pfad As String, Datei As String, Ext As String Set TB1 = Sheets("export") Set TB2 = Sheets("csv_datei") Z1 = 11 'erste Datenzeile Pfad = "E:\Excel\Temp\" 'mit \ am Ende Ext = ".csv" 'reset TB2.Range("I2:L2").ClearContents With TB1 LR = .Cells(.Rows.Count, "C").End(xlUp).Row 'letzte Zeile der Spalte For i = Z1 To LR If .Cells(i, 3) > "" Then SRV = SRV & ";" & .Cells(i, 3) Select Case .Cells(i, 7) Case "", 0, 1 Mng = Mng & ";" & .Cells(i, 14) Case Else Mng = Mng & ";" & .Cells(i, 14) & "*" & .Cells(i, 7) End Select LTxt = LTxt & ";" STxt = STxt & ";" End If Next End With With TB2 Datei = .Cells(2, 1) .Cells(2, 9) = Mid(SRV, 2) 'erstes Semi wird weggelassen .Cells(2, 10) = Mid(Mng, 2) .Cells(2, 11) = LTxt .Cells(2, 12) = STxt 'Blatt auswählen, nur das Aktive wird exportiert .Activate End With Application.DisplayAlerts = False ' "Schon vorhanden" abschalten ActiveWorkbook.SaveAs Filename:=Pfad & Datei & Ext, FileFormat:=xlCSVMSDOS, Local:=True Application.DisplayAlerts = True End Sub

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

305 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Bereiche als CSV exportieren

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

305 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread