Nhờ anh em giúp code chạy nhiều file đuôi .txt vào file excel. (1 người xem)

[mr.keke]

Nhờ anh em giúp em code để chạy nhiều file có đuôi .txt vào 1 file excel.
Em có nhiều file có đuôi .txt giờ e cho nó chạy vào 1 file excel nhờ anh em giúp đở. Cảm ơn nhiều.
Em có đính kèm file bên dưới.

 

[befaint]

Nhờ anh em giúp em code để chạy nhiều file có đuôi .txt vào 1 file excel.
Em có nhiều file có đuôi .txt giờ e cho nó chạy vào 1 file excel nhờ anh em giúp đở. Cảm ơn nhiều.
Em có đính kèm file bên dưới.

Chào bạn,

Bạn thử file đính kèm nhé.
(Mở file, cho phép chạy macro, click nút "Import Text", chọn folder chứa các file text cần lấy thông tin, click OK).

Sub impTXT()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim iPath As String, iFile(), i As Long, path As String
On Error Resume Next
iPath = GetFolder("")
If iPath = "" Then Exit Sub
iFile = GetFileList(iPath)
For i = 1 To UBound(iFile)
path = iPath & "\" & iFile(i)
    With Sheet2.QueryTables.Add(Connection:= _
        "TEXT;" & path, Destination:=Sheet2.Range("$A$1"))
        .TextFilePlatform = 65001
        .TextFileStartRow = 1
        .TextFileParseType = xlFixedWidth
        .TextFileColumnDataTypes = Array(1)
        .Refresh BackgroundQuery:=False
    End With
GetData
Sheet2.Range("A1:H100").Clear
Sheet2.QueryTables(1).Delete
Next i
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
'---------------------------------
Sub GetData()
Dim TXT(), i As Integer, cll As Range, lr As Long
Set cll = Sheet2.Range("A1")
ReDim TXT(1 To 6)
TXT(1) = Left(cll.Value, InStr(1, cll.Value, "   ") - 1)
If Tach(cll.Offset(1).Value) = "" Then Sheet2.Rows(2).Delete
For i = 2 To 6
    TXT(i) = Tach(cll.Offset(i - 1).Value)
Next i
lr = Sheet1.Range("A65000").End(xlUp).Row + 1
Sheet1.Range("A" & lr).Offset(0, 3).Resize(1, 2).NumberFormat = "dd/mm/yyyy"
Sheet1.Range("A" & lr).Resize(1, 6).Value = TXT
End Sub

 

[mr.keke]

Chào bạn,

Bạn thử file đính kèm nhé.
(Mở file, cho phép chạy macro, click nút "Import Text", chọn folder chứa các file text cần lấy thông tin, click OK).

Sub impTXT()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim iPath As String, iFile(), i As Long, path As String
On Error Resume Next
iPath = GetFolder("")
If iPath = "" Then Exit Sub
iFile = GetFileList(iPath)
For i = 1 To UBound(iFile)
path = iPath & "\" & iFile(i)
    With Sheet2.QueryTables.Add(Connection:= _
        "TEXT;" & path, Destination:=Sheet2.Range("$A$1"))
        .TextFilePlatform = 65001
        .TextFileStartRow = 1
        .TextFileParseType = xlFixedWidth
        .TextFileColumnDataTypes = Array(1)
        .Refresh BackgroundQuery:=False
    End With
GetData
Sheet2.Range("A1:H100").Clear
Sheet2.QueryTables(1).Delete
Next i
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
'---------------------------------
Sub GetData()
Dim TXT(), i As Integer, cll As Range, lr As Long
Set cll = Sheet2.Range("A1")
ReDim TXT(1 To 6)
TXT(1) = Left(cll.Value, InStr(1, cll.Value, "   ") - 1)
If Tach(cll.Offset(1).Value) = "" Then Sheet2.Rows(2).Delete
For i = 2 To 6
    TXT(i) = Tach(cll.Offset(i - 1).Value)
Next i
lr = Sheet1.Range("A65000").End(xlUp).Row + 1
Sheet1.Range("A" & lr).Offset(0, 3).Resize(1, 2).NumberFormat = "dd/mm/yyyy"
Sheet1.Range("A" & lr).Resize(1, 6).Value = TXT
End Sub

Cảm ơn bác quá nhiều luân...