Tổng hợp nhiều file vào 1 file (1 người xem)

[lptinfo40]

Chào các anh chị GPE,

Hiện tại em đang làm 1 file tổng hợp thông tin từ nhiều file vào 1 file, nhưng do file tổng hợp và file data gốc không giống nhau nên em đang làm theo kiểu set giá trị vào 1 biến và paste giá trị đó vào 1 ô định sẵn trong file tổng hợp.
Nhưng không biết sao bị lỗi mà em chưa sửa được, các anh, chị giúp đỡ em với.

Em cảm ơn các anh,chị!

 

[lptinfo40]

Lỗi không thì tôi chả biết. Nhìn code bạn viết hãi......quá...Thôi thì bạn chạy thử code này. Nếu trúng thì hên...còn không thì la lên nha!
Tống tất cả các file cần update vào1 Thư mục. Sau đó chạy code, cửa số mở ra...Chọn Folder (thư mục) chứa file con và nhấn OK.

Public Sub GPE()
Dim ChonO As Object, ChonF As Object, pFile, Path, ShMain As Worksheet
Dim fil As Object, Wb As Workbook, Sh As Worksheet, WbMain As Workbook
Dim Arr, dArr(1 To 65000, 1 To 45), I As Long, K As Long, J As Long, sArr
sArr = Array(1, 2, 3, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 24, 26, 28, 30, 31, 32, 34, _
35, 36, 37, 38, 39, 40, 41, 42, 43, 19, 21, 20, 24, 26, 28, 50, 51)
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set WbMain = ActiveWorkbook
Set ShMain = WbMain.Sheets("02.Thay doi tinh trang")
pFile = WbMain.Name
With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "CHON FOLDER"
    .Show
    If .SelectedItems.Count = 0 Then Exit Sub
    Path = .SelectedItems(1) & "\"
End With
Set ChonO = CreateObject("Scripting.FilesystemObject")
Set ChonF = ChonO.GetFolder(Path)
For Each fil In ChonF.Files
If InStr(1, fil.Name, pFile) <= 0 Then
    Set Wb = Workbooks.Open(fil.Path)
        Set Sh = Wb.Sheets("02.Thay doi tinh trang")
        Arr = Sh.Range("B5", Sh.Range("B65000").End(3)).Resize(, 51).Value
            For I = 1 To UBound(Arr)
                If Arr(I, 1) <> Empty Then
                    K = K + 1
                    dArr(K, 1) = K
                    For J = 0 To UBound(sArr)
                        dArr(K, J + 2) = Arr(I, sArr(J))
                    Next J
                End If
            Next I
    Workbooks(fil.Name).Close
End If
Next fil
    ShMain.Range("B5").Resize(65000, 45).ClearContents
    If K Then ShMain.Range("B5").Resize(K, 45).Value = dArr
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Thanks bạn nhé, mình đã chạy được rồi, nhưng mà có 1 chút nữa là ở file tonghop.xlsm, từ cột AM đến cột AN mình không có paste dữ liệu vào, mình chỉ paste đến AK và thêm cột AS, AT nữa thôi.