CSV Export über mehrere Blätter

[crowley83]

Hallo zusammen,

aktuell habe ich ein für mich kniffeliges Problem, und hoffe jemand kann mir weiterhelfen :)

Ich habe quasi eine tägl. Datei, in dieser Datei habe ich 2 Blätter, in beiden Blättern habe ich den Bereich B6:CC504 mit Daten gefüllt.
In B7:B504 stehen normal Artikelnummern, doch es kann sein das an einen Tag 50 am anderen 250 drin stehen.
Aktuell mache ich einen Datenabruf und kopiere die gefüllten Spalten in eine "import.csv" hinein, doch leider kommen meine Kollegen damit nicht klar.

Daher, hat jemand eine Idee, wie ich folgendes via VBA erreichen kann?

Exportiere Tabelle1 B6:B504 sofern B6 gefüllt ist (Loop bis B504), dann Tabelle2 B6:B504 sofern B6 gefüllt ist (Loop bis B504) als Wert und erstelle die import.csv

Wie gesagt, das Problem ist halt das nicht immer eine Artikelnummer in den Tabellen steht, und keine leeren Zeilen in der import.csv stehen dürfen.

Ich bedanken mich schonmal im voraus :)

BG

Ps. gerne kann ich auch eine Musterdatei nachliefern.

[Rumo0815]

Chat GPT sagt:

Code:

Sub ExportDataToCSV()
    Dim wb As Workbook
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim lastRow As Long, i As Long
    Dim dataArr1() As Variant, dataArr2() As Variant
    Dim csvFilePath As String
   
    ' Set the workbook and worksheet objects
    Set wb = ThisWorkbook
    Set ws1 = wb.Sheets("Tabelle1")
    Set ws2 = wb.Sheets("Tabelle2")
   
    ' Find the last row in the first sheet
    lastRow = ws1.Cells(ws1.Rows.Count, "B").End(xlUp).Row
   
    ' Check if there is data in the first sheet
    If lastRow < 6 Then
        MsgBox "No data to export.", vbInformation
        Exit Sub
    End If
   
    ' Resize the array to hold the data
    ReDim dataArr1(1 To lastRow - 5, 1 To 1)
   
    ' Loop through the data in the first sheet and populate the array
    For i = 6 To lastRow
        If ws1.Cells(i, "B").Value <> "" Then
            dataArr1(i - 5, 1) = ws1.Cells(i, "B").Value
        End If
    Next i
   
    ' Find the last row in the second sheet
    lastRow = ws2.Cells(ws2.Rows.Count, "B").End(xlUp).Row
   
    ' Check if there is data in the second sheet
    If lastRow < 6 Then
        MsgBox "No data to export.", vbInformation
        Exit Sub
    End If
   
    ' Resize the array to hold the data
    ReDim dataArr2(1 To lastRow - 5, 1 To 1)
   
    ' Loop through the data in the second sheet and populate the array
    For i = 6 To lastRow
        If ws2.Cells(i, "B").Value <> "" Then
            dataArr2(i - 5, 1) = ws2.Cells(i, "B").Value
        End If
    Next i
   
    ' Check if both arrays are empty
    If IsArrayEmpty(dataArr1) And IsArrayEmpty(dataArr2) Then
        MsgBox "No data to export.", vbInformation
        Exit Sub
    End If
   
    ' Prompt the user to choose a save location for the CSV file
    With Application.FileDialog(msoFileDialogSaveAs)
        .Title = "Save CSV File"
        .Filter = "CSV files (*.csv)|*.csv"
       
        If .Show = -1 Then
            csvFilePath = .SelectedItems(1)
        Else
            Exit Sub
        End If
    End With
   
    ' Create the CSV file and write the data
    On Error GoTo ErrorHandler
    Open csvFilePath For Output As #1
   
    ' Write data from the first array
    If Not IsArrayEmpty(dataArr1) Then
        For i = LBound(dataArr1, 1) To UBound(dataArr1, 1)
            Print #1, dataArr1(i, 1)
        Next i
    End If
   
    ' Write data from the second array
    If Not IsArrayEmpty(dataArr2) Then
        For i = LBound(dataArr2, 1) To UBound(dataArr2, 1)
            Print #1, dataArr2

Achtung: alle Kommata müssen durch Semikolon ersetzt werden!

Hinweis: Nicht getestet!

[d'r Bastler]

Moin Crowley,

erst einmal zusammengefasst, was ich glaube verstanden zu haben: 

Du hast zwei (oder mehrere?) Tabellenblätter, aus denen Daten in eine CSV zusammengeführt werden sollen, sofern Zelle B6 nicht leer ist. Das heißt, der erste Filter ist B6. Soweit korrekt?
Leerzeilen dürfen nicht in die CSV übergeben werden. Das also als Filter im zweiten Schritt. Soweit korrekt?

Dann lässt sich das über folgende Schleifen lösen:

Äußere Schleife über das ganze Workbook [PseudoCode]

• For each Sheet in This Workbook 'damit werden alle Sheets abgeharkt
  
• If Cells(6,2) <> "" then
  

Innere Schleife über die aktive Tabelle

• for i = 1 to Usedrange.rows.count  'damit werden die vorhanden Zeilen abgeharkt, egal ob 50 oder 249
  
• If Cells(i,1) = "" then i = i+1
  
• else
  

Und nun die Aktion:
Entweder du schreibst die gefundenen Daten erst einmal in eine Zwischentabelle oder direkt in die CSV.
Innere Schleife beendet, nächste Runde Äußere...

Falls ich wenigstens der Spur nach richtig liege, mein Vorschlag: Mach das Thema hier auf und helfe Dir gerne.
Der ChatGP-Code mag funktionieren, was ich nicht testen werde. Handgemachter Code ist mal gleich deutlich kürzer...

Schöne Grüße

[crowley83]

Hallo zusammen,

danke für die ersten Antworten.

Ich habe nun mal eine Beispieldatei gebaut.

Also: In Tabelle1 die Spalte U-1 ist Dynamisch, der Rest der Tabelle Statisch mit Formeln.
Ich rufe also meine Daten ab, im Rest wird ein Index durchgeführt.

Die VBA soll nun in Tabelle1 in Spalte U-1 nach unten prüfen und wenn gefüllt die Zeilen (inkl. Überschrift) in eine CSV Datei schreiben. Wenn er dort fertig ist, Tabelle2 in Spalte U-1 nach unten prüfen und wenn gefüllt die Zeilen (ohne Überschrift) in die selbe CSV schreiben. 

Die CSV soll dann als Import.CSV auf dem Desktop gespeichert werden.

An ChatGPT hätte ich bei so einem Problem nie Gedacht.tGPT

---

Hi. danke für deinen Input, ich habe soeben eine Beispieldatei für mein Problem gebaut.

Einfach nur interessehalber ;) Was macht es für einen Unterschied ob ich es hier schreibe oder in deinem Forum https://www.vbasteleien.de/?

BG Crowley

[d'r Bastler]

Moin crowley,

zur Frage hier oder dort: Foren leben von den Beiträgen ihrer Nutzer und die Basteleien versuchen sich als freundlicherer Nachfolger der office-loesungen.de, die es leider nicht mehr gibt. Verstehe meinen Satz als Einladung, die du annehmen oder ausschlagen kannst.

zu Deinem Thema: mal abgesehen davon, dass Du mit Deiner Beschreibung (zumindest für XL-Menschen) schon etwas Verwirrung stiftest, stehen doch die Daten U-1 in XL-Spalte B(2) verweise ich gerne noch mal meinen Vorschlag aus meinem Beitrag von gestern 13:45. Mit der dort genannten Schleifenlösung lässt sich das zügig realisieren.

Schönen Abend noch!

[derHoepp]

Moinsen,

ich finde den Hinweis, in ein anderes Forum zu wechseln etwas befremdlich.

Ich würde auch von einer Schleife abraten, dafür gibt es doch den Autofilter. Insgesamt würde ich das Verfahren aber wahrscheinlich ganz anders aufbauen.
Ziel eins wäre es dabei vollständig auf getrennte Teiltabellen zu verzichten. Wofür benötigst du die überhaupt? Und warum hältst du überhaupt nicht benötigte Zeilen vor?
Als zweitbeste Lösung würde ich die Einzeltabellen mit Powerquery zusammenführen und anschließend das ganze neue Blatt nur noch als CSV-Datei speichern.

Eine Beispieldatei würde da beim Helfen helfen.

Viele Grüße
derHöpp

Nachtrag: Die Beispieldatei hab ich jetzt auch gesehen. Meine Hinweise gelten vollumfänglich weiter ;)