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