Lấy dữ liệu từ các File vào chung 1 File! Xin trợ giúp (1 người xem)

[dqdung]

Tôi mới sử dụng EXCEL chỉ mới biết cơ bản. Hiện giờ có nhu cầu tổng hợp thông tin của 1 số File vào chung 1 File
Tử 3 File ( hoặc nhiều hơn.. Tôi tạm cần lấy dữ liêụ từ 03 file ) vào 1 File chung. File đính kèm gồm 4 File, tôi cần lấy dữ liệu từ tất cả giá trị từ ô A6 tới ô AG850 trong SHEET cùng tên với tên File ( cả 3 File B777, A330, A320-A321 ) vào SHEET Total của File Tong hop cac File.
File đính kèm https://www.dropbox.com/s/6wro4ro47p7zpn0/FILE CHUAN.rar?m

Điều kiện : 3 File dữ liệu nguồn không cần mở. Chỉ phải mở File TONG HOP CAC FILE.xls và chay VB là dữ liệu chuyển sang.
Cám ơn các bác trước!

 

[Hai Lúa Miền Tây]

Tôi mới sử dụng EXCEL chỉ mới biết cơ bản. Hiện giờ có nhu cầu tổng hợp thông tin của 1 số File vào chung 1 File
Tử 3 File ( hoặc nhiều hơn.. Tôi tạm cần lấy dữ liêụ từ 03 file ) vào 1 File chung. File đính kèm gồm 4 File, tôi cần lấy dữ liệu từ 1.) Tất cả giá trị từ ô A6 tới ô AG850 trong SHEET cùng tên với tên File ( cả 3 File B777, A330, A320-A321 ) vào SHEET Total của File Tong hop cac File.
File đính kèm https://www.dropbox.com/s/6wro4ro47p7zpn0/FILE CHUAN.rar?m

Điều kiện : 2.) 3 File dữ liệu nguồn không cần mở. Chỉ phải mở File TONG HOP CAC FILE.xls và chay VB là dữ liệu chuyển sang.
Cám ơn các bác trước!

1./ Bạn có chắc rằng tên file và tên sheet giống nhau, mình thấy trong file ví dụ có 2 file với tên file và tên sheet không giống nhau.
2./ Có thể dùng ADO để thực hiện điều này.

Bạn cần làm rõ 2 vấn đề nêu trên xong rồi ta mới tiếp tục nhé.

 

[Hai Lúa Miền Tây]

Đợi bạn trả lời lâu quá, thôi thì làm đại, đúng sai gì đó kệ.
1./ Đã chỉnh tên file và tên sheet giống nhau.
2./ Dùng ADO để giải bài toán này.

Sub GopFile()
Dim cn As New ADODB.Connection, adoRS As New ADODB.Recordset
Dim FileItem As Object, strFile As String, strTableName As String
  On Error GoTo BaoLoi
    Range("A6:AG65000").ClearContents
      For Each FileItem In CreateObject("Scripting.FileSystemObject").GetFolder(BrowseForFolder).Files
        If FileItem.Path Like "*.xls" Then
          strFile = FileItem.Path
          strTableName = FileItem.Name
            If strFile <> ThisWorkbook.FullName Then
                With cn
                    .ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                                                  "Data Source=" & strFile & _
                                                  ";Extended Properties=""Excel 8.0;HDR=No;"";"
                    .Open
                End With
                With adoRS
                    .ActiveConnection = cn
                    .Open "SELECT * FROM [" & Replace(strTableName, ".xls", "") & "$A6:AG850]"
                End With
                Application.ScreenUpdating = False
                    Range("A" & Range("A65000").End(xlUp).Row + 1).CopyFromRecordset adoRS
                Application.ScreenUpdating = True
                adoRS.Close
                cn.Close
            End If
        End If
      Next
    Set cn = Nothing: Set adoRS = Nothing
    Exit Sub
BaoLoi:
MsgBox Err.Description
End Sub
Function BrowseForFolder(Optional OpenAt As Variant) As Variant
   Dim ShellApp As Object
    Set ShellApp = CreateObject("Shell.Application"). _
        BrowseForFolder(0, "Vui long chon folder co chua file ma ban can gop.", 0, OpenAt)
    On Error Resume Next
        BrowseForFolder = ShellApp.self.Path
    On Error GoTo 0
    Set ShellApp = Nothing
    Select Case Mid(BrowseForFolder, 2, 1)
        Case Is = ":"
            If Left(BrowseForFolder, 1) = ":" Then GoTo Invalid
        Case Is = "\"
            If Not Left(BrowseForFolder, 1) = "\" Then GoTo Invalid
        Case Else
            GoTo Invalid
    End Select
    Exit Function
Invalid:
    BrowseForFolder = False
End Function

Lưu ý: Bạn tải file về, giải nén, nhấn nút Gộp Sheet, sau đó chọn folder có chứa tất cả các file cần gộp.