Textdatei mit Datum als Name speichern

Private Sub Test()
Workbooks.Open Filename:="C:\Test.xls"
Dim rng As Range
Dim intFF As Integer
Dim intSpalte As Integer
Dim strZeile As String
On Error GoTo ErrHdl
intFF = FreeFile
Open "C:\Test.txt" For Output As #intFF
With ActiveSheet
For Each rng In .Range(.Cells(1, 6), .Cells(Rows.Count, 6).End(xlUp))
If rng = 1 Then
For intSpalte = -5 To -4
strZeile = strZeile & rng.Offset(0, intSpalte).Text & "     "
Next 'intspalte
strZeile = Left(strZeile, Len(strZeile) - 1)
Print #intFF, strZeile
strZeile = ""
End If
Next 'lngZeile
End With
ErrHdl:
Close #intFF
Application.DisplayAlerts = False
Workbooks("Test.xls").Close
End Sub

Mit freundlichen Grüßen
Benjamin