Sub CreateAuswertungFile()
Dim colText As Collection
Dim FlNr As Integer
FlNr = FreeFile
Open "L:\temp\Auswertung.txt" For Output As FlNr
FillValues FlNr, Range("B1")
Print #FlNr, ""
FillValues FlNr, Range("C1")
Print #FlNr, ""
FillValues FlNr, Range("D1")
Print #FlNr, ""
Close #FlNr
End Sub
Sub FillValues(FileNr As Integer, rng As Range)
Dim rngData As Range
Dim rngVal As Range
Set rngData = Range(rng, Cells(rng.Worksheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row, rng.Column))
For Each rngVal In rngData.Cells
If Len(rngVal.Value) > 0 Then
Print #FileNr, rngVal.Value
End If
Next
End Sub