VBA代码将表格从txt文件传输到excel

Question

我正在编写代码来读取 txt 文件中的表格，并将第一个列导出到 Excel 表格中。但由于某种原因，我遇到了一些错误。它继续复制我不想要的第一行并错过表中的最后一行。

有关图片，请参阅错误 1 ​​和错误 2。错误 1 ​​显示了 txt 文件和我要“复制”的表。错误 2 显示了它是如何导入到 excel 中的。如您所见，它错过了“9.5”行，而是复制了“name and dev”行

  Sub AddNewData()
If ActiveSheet.Name <> "EntryPage" Then GoTo EnterData
Pump_Tag_ID = InputBox("Please Type Pump Tag:", "Enter Pump Tag")
If Pump_Tag_ID = "" Then End
Worksheets("ImplementationSheet").Range("H1") = Pump_Tag_ID
TotalSheets = ThisWorkbook.Worksheets.Count
For Each Sheet In Worksheets
        If Pump_Tag_ID = Sheet.Name Then
            Sheets(Pump_Tag_ID).Activate
        Else
        i = i + 1
        End If
    Next Sheet
    If i = TotalSheets Then
        Dim Ans As Integer
            Ans = MsgBox("The Pump Tag # does not exist. Please add it.", vbOKCancel + vbInformation)
        Select Case Ans
            Case vbOkay: GoTo Form_AddNewTag
            Case vbCancel: Exit Sub
        End Select
Form_AddNewTag:
        AddNewTag.Show
    End If
If cContinue = "No" Then End
'Get The Data
EnterData:
CurrentSheet = ActiveSheet.Name
'Application.ScreenUpdating = False



Dim myObj As Object
Dim myDirString As String

Set myObj = Application.FileDialog(msoFileDialogFilePicker)

With myObj
    .InitialFileName = "C:\Users\" & Environ$("Username") & ".domain\Documents"
    .Filters.Clear
    .Filters.Add "Text Files", "*.txt", 1
    If .Show = False Then MsgBox "Please select TXT file.", vbExclamation: Exit Sub
    myDirString = .SelectedItems(1)
End With
Sheets.Add
With ActiveSheet.QueryTables.Add(Connection:= _
    "TEXT;" & myDirString, Destination:=Range("$A$1"))
     .Name = "TxtImport"
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .TextFilePromptOnRefresh = False
    .TextFilePlatform = 1252
    .TextFileStartRow = 1
    .TextFileParseType = xlDelimited
    .TextFileTextQualifier = xlTextQualifierDoubleQuote
    .TextFileConsecutiveDelimiter = False
    .TextFileTabDelimiter = True
    .TextFileSemicolonDelimiter = False
    .TextFileCommaDelimiter = False
    .TextFileSpaceDelimiter = True
    .TextFileColumnDataTypes = Array(2, 1, 1, 1, 1)
    .TextFileTrailingMinusNumbers = True
    .Refresh BackgroundQuery:=False
End With

'rest of the formatting codes here
Range("B1") = "=MATCH(""CSYS:"",A:A,0)"
dDate = Range("C2")
DataStart = Range("B1") + 1
Range(Cells(DataStart, 1), Cells(DataStart + 24, 2)).Copy Worksheets("ImplementationSheet").Range("A1:B25")
Application.DisplayAlerts = False
ActiveSheet.Delete
Application.DisplayAlerts = True


    Worksheets("ImplementationSheet").Activate
    Worksheets("ImplementationSheet").Range("A1:B25").Select
    ActiveWorkbook.Worksheets("ImplementationSheet").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("ImplementationSheet").Sort.SortFields.Add Key:= _
        Worksheets("ImplementationSheet").Range("A2:A25"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortTextAsNumbers
    With ActiveWorkbook.Worksheets("ImplementationSheet").Sort
        .SetRange Worksheets("ImplementationSheet").Range("A2:B25")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Worksheets("ImplementationSheet").Range("A1").Select

Worksheets("ImplementationSheet").Range("F1") = dDate
Worksheets(CurrentSheet).Activate
Application.ScreenUpdating = True
NewOrExistingVolute.Show

End Sub

错误 1

错误 2

Answer 1

试试这个，如果你得到不同的结果，请告诉我：

DataStart = Range("B1").Row + 1