Sub WriteStrings()
Dim sLine As String
Dim sFName As String 'Path and name of text file
Dim iFNumber As Integer 'File number
Dim lRow As Long 'Row number in worksheet
sFName = "C:\Strings.txt"
iFNumber = FreeFile
Open sFName For Output As #iFNumber
lRow = 2
Do
With Sheet1
sLine = Format(.Cells(lRow, 1), "yyyy-mmm-dd") & ";"
sLine = sLine & .Cells(lRow, 2) & ";"
sLine = sLine & .Cells(lRow, 4) & ";"
sLine = sLine & Format(.Cells(lRow, 6), "0.00")
End With
Print #iFNumber, sLine
lRow = lRow + 1
Loop Until IsEmpty(Sheet1.Cells(lRow, 1))
Close #iFNumber
End Sub