导入数据总是多删一个单元格

921417931

求助大神，从A3单元格开始导入文本数据，A2单元格内的数据会被删掉，不知道是哪里出了问题。

下面是代码：

Sub 读取文件()
Range("A3:G1048576").Select
Selection.ClearContents
Dim fileToOpen As Variant, texts As String, lines() As String
fileToOpen = Application.GetOpenFilename(FileFilter:="Text Files (*.txt;*.csv;*.dat),   *.txt;*.csv;*.dat", MultiSelect:=False)
If fileToOpen <> False Then
End If

Open fileToOpen For Input As #1
Do While Not EOF(1)
Line Input #1, Text
i = i + 1
ReDim Preserve lines(i)
lines(i) = Text
Loop
Close #1
r = UBound(lines) + 2
Range("A2:" & "A" & r) = WorksheetFunction.Transpose(lines)
Range("A3:A" & [A1048576].End(xlUp).Row).Select
Selection.TextToColumns Destination:=Range("A3"), _
DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
comma:=True, Space:=True, Other:=False, fieldinfo:=Array(1, 1), TrailingMinusNumbers:=True
End Sub