Automatisch in nächste Zeile schreiben

Private Sub CommandButton1_Click()
Dim FileName As String
Dim FileNum As Integer
Dim ResultStr As String
Dim wsSheet As Worksheet
Dim strValues(65536, 1) As String
Dim lngRow As Long
Dim intSheet As Integer
Dim intCounter As Integer
ActiveCell.Activate
FileName = Application.GetOpenFilename("Textdateien " _
& "(*.txt; *.csv),*.txt; *.csv")
If FileName = "" Or FileName = "Falsch" Then Exit Sub
FileNum = FreeFile()
Open FileName For Input As #FileNum
Application.ScreenUpdating = False
ActiveSheet.Select
lngRow = 1
intSheet = 1
Application.StatusBar = "Blatt " & intSheet & " wird eingelesen"
Do While Seek(FileNum) <= LOF(FileNum)
Line Input #FileNum, ResultStr
If Left(ResultStr, 1) = "=" Then
strValues(lngRow, 1) = "'" & ResultStr
Else
strValues(lngRow, 1) = ResultStr
End If
If lngRow < 65536 Then
lngRow = lngRow + 1
Else
ActiveSheet.Range("A6:A1000") = strValues
ActiveWorkbook.Worksheets.Add after:=Worksheets(Worksheets.Count)
lngRow = 1
intSheet = intSheet + 1
Application.StatusBar = "Blatt " & intSheet & " wird eingelesen"
End If
Loop
Close
ActiveSheet.Range("A6:A1000") = strValues
If MsgBox("Sollen die eingelesenen Daten auf Spalten verteilt werden?", _
vbYesNo, "Text in Spalten") = vbNo Then
Application.ScreenUpdating = True
Application.StatusBar = "Fertig"
Exit Sub
End If
intSheet = 0
For Each wsSheet In ActiveWorkbook.Worksheets
intSheet = intSheet + 1
Application.StatusBar = "Daten von Blatt " & intSheet _
& " werden bearbeitet"
With ActiveSheet
.Range("A6:A1000").TextToColumns Destination:=.Range("A6"), _
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, _
Tab:=False, _
Semicolon:=True, _
Comma:=False, _
Space:=False, _
Other:=False
End With
Next wsSheet
Application.ScreenUpdating = True
Application.StatusBar = "Fertig"
End Sub