请教高手如何将批量txt文件导入excel里，只需第一二行和最后一

【 在 zyyozyyozyy 的大作中提到: 】 : 能不能帮我写个宏的代码~ : 代码要求是。批量导入一个文件夹下的所有txt到excel，但是只录入每个txt的第一二行和最后一行的数据。txt的文件名作为这部分数据的表头。之后所有的txt文件所录入的数据合并在一个excel表格内 : -- : ................... 附件(28KB) 请测试~

'made by fxw Sub D20合并文本() Dim fd As FileDialog Set fd = Application.FileDialog(msoFileDialogFilePicker) Dim newwb As Workbook Set newwb = Workbooks.Add newwb.Application.ActiveWindow.Caption = "MergeTXT.xls" With fd .Filters.Clear .Filters.Add "文本文件", "*.txt", 1 .Filters.Add "所有文件", "*.*", 2 .Title = " 请选择要合并的txt文件 " If .Show = -1 Then Application.ScreenUpdating = False Dim vrtSelectedItem As Variant Dim i As Integer i = 1 For Each vrtSelectedItem In .SelectedItems Dim tempwb As Workbook Set tempwb = Workbooks.Open(vrtSelectedItem) tempwb.Worksheets(1).Copy Before:=newwb.Worksheets(i) newwb.Worksheets(i).Name = VBA.Replace(tempwb.Name, ".txt", "") tempwb.Close savechanges:=False i = i + 1 Next vrtSelectedItem Else: newwb.Close savechanges:=False Exit Sub End If End With For i = 1 To Sheets.Count Sheets(i).Select If ActiveSheet.UsedRange.Rows.Count > 3 Then Rows("3:" & ActiveSheet.UsedRange.Rows.Count - 1).Select Selection.Delete Shift:=xlUp Cells(1, 1).Select End If Next i Set fd = Nothing Sheets(1).Select Application.ScreenUpdating = True MsgBox "ok~" End Sub