Problem

Es sollen alle Tabellen einer Excelmappe durchlaufen und in eine Textdatei geschrieben werden

Lösung

Sub Schaltfläche1_Klicken()
    ' Erzeugt eine Textdatei
    On Error Resume Next
    
    Dim i, j As Integer
    Dim letzteZeile As Integer
    Dim workbookName As String
    Dim artikelname As String
    Dim EANNummer As String
    Dim UmsatzVKBrutto As String
    Dim Absatz As String
    Dim VKPreisSap As String
    Dim UST As String
    
    Dim csvZeile As String
    
    Open "d:\daten\liste.txt" For Output As #1
    
    For i = 2 To ThisWorkbook.Sheets.Count - 1
        workbookName = ThisWorkbook.Sheets(i).Name
        ' Finde die letzte Zeile
        letzteZeile = Worksheets(workbookName).Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row + 1
        
        For j = 1 To letzteZeile
            If Trim(ThisWorkbook.Sheets(i).Cells(j, 1)) <> "" Then
                artikelname = ThisWorkbook.Sheets(i).Cells(j, 1)
                EANNummer = ThisWorkbook.Sheets(i).Cells(j, 2)
                UmsatzVKBrutto = ThisWorkbook.Sheets(i).Cells(j, 3)
                Absatz = ThisWorkbook.Sheets(i).Cells(j, 4)
                
                If IsError(ThisWorkbook.Sheets(i).Cells(j, 5).Value) = True Then
                    VKPreisSap = "#nv"
                Else
                    VKPreisSap = CStr(ThisWorkbook.Sheets(i).Cells(j, 5))
                End If
                
                If IsError(ThisWorkbook.Sheets(i).Cells(j, 6).Value) = True Then
                    UST = "#nv"
                Else
                    UST = CStr(ThisWorkbook.Sheets(i).Cells(j, 6))
                End If
                
                csvZeile = workbookName & ";" & artikelname & ";" & EANNummer & _
                ";" & UmsatzVKBrutto & ";" & Absatz & ";" & VKPreisSap & ";" & UST
                Print #1, csvZeile
                
            End If
        Next j
    Next i
    
    Close #1

End Sub