Cập nhật dữ liệu từ nhiều file excel khác nhau về 1 file tổng hợp? (1 người xem)

[haikimcuong]

Em xin có 1 câu hỏi thế này ạ.
Giờ em đang có 3 file excel và để lưu chung vào 1 địa chỉ là: D/QLC/DANH SACH
Em đã gửi danh sách cả 4 file ở tập new folder và trong đó em muốn lấy tất cả cột thành tiền trong 3 file về file tổng hợp theo mẫu ở tổng hợp, số liệu sẽ tương ứng với ngày phát sinh ạ.
Xin cảm ơn anh chị

 

[hngiatuong]

Giải pháp tạm thời
Mình chưa nghĩ ra công thức nhưng mình bảo bạn làm tạm bằng cách thủ công
Mở cả 4 file ra sau đó chọn Window\Arrange …\Vertical\OK rồi đặt lệnh =giá trị của ô bạn muốn Sheet1- năm trong file A rồi kéo. Tương tự như vậy
Trong khi mọi người nghĩ cách hoàn hảo hơn.

 

[hngiatuong]

Giải pháp tạm thời
Mình chưa nghĩ ra công thức nhưng mình bảo bạn làm tạm bằng cách thủ công
Mở cả 4 file ra sau đó chọn Window\Arrange …\Vertical\OK rồi đặt lệnh =giá trị của ô bạn muốn Sheet1- năm trong file A rồi kéo. Tương tự như vậy. Hoặc dùng lệnh Vlookup
Trong khi mọi người nghĩ cách hoàn hảo hơn.

 

[Ba Tê]

Em xin có 1 câu hỏi thế này ạ.
Giờ em đang có 3 file excel và để lưu chung vào 1 địa chỉ là: D/QLC/DANH SACH
giờ em đang muốn lấy cột dữ liệu ở tất cả 3 file đó để đưa sang 1 file tổng hợp thì có làm được không các thầy. Em xin được ví dụ theo file đính kèm trong đó có 4 sheet tượng chưng mỗi sheet sẽ nằm trong 1 file A, B, C và sheet tổng hợp.
nhưng trên thực tế 3 sheet lấy dữ liệu sẽ nằm ở 3 file có tên A, B, C khác nhau
và việc là liên kết sao cho như trong sheet tổng hợp.
Em xin cảm ơn

Khỏi ví dụ, bạn đưa 4 file có cấu trúc chuẩn lên đây, giải thích rõ yêu cầu và kết quả mẫu (nhập thủ công) sẽ có người trả lời cho bạn, ví dụ sẽ không giống thật, làm rồi chẳng sử dụng được cũng như không, mất công.

 

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

Em xin có 1 câu hỏi thế này ạ.
Giờ em đang có 3 file excel và để lưu chung vào 1 địa chỉ là: D/QLC/DANH SACH
Em đã gửi danh sách cả 4 file ở tập new folder và trong đó em muốn lấy tất cả cột thành tiền trong 3 file về file tổng hợp theo mẫu ở tổng hợp, số liệu sẽ tương ứng với ngày phát sinh ạ.
Xin cảm ơn anh chị

Sử dụng code này:

[GPECODE=sql]Sub GopFile()
Dim cn As Object, adoRS As Object, cat As Object, tbl As Object, FileItem As Object
Dim strTableName As String, i As Integer, endR As Integer, strFile As String
Set cn = CreateObject("ADODB.Connection")
Set adoRS = CreateObject("ADODB.Recordset")
Set cat = CreateObject("ADOX.Catalog")
Cells.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=Yes;HDR=No;IMEX=1"";"
.Open
End With
cat.ActiveConnection = cn

If (Right(cat.Tables(0).Name, 1) = "$") Or (Right(cat.Tables(0).Name, 2) = "$'") Then
strTableName = Replace(cat.Tables(0).Name, "'", "")
MsgBox strTableName
With adoRS
.ActiveConnection = cn
.Open "SELECT '" & strFile & "' as [Duong Dan],'" & strTableName & "' as [Ten Sheet], * FROM [" _
& strTableName & "A1:E5000]"
endR = Range("A65000").End(xlUp).Row + 1
Application.ScreenUpdating = False
Range("A" & endR).CopyFromRecordset adoRS
Application.ScreenUpdating = True
.Close
cn.Close
End With
End If
End If
End If
Next
Set cn = Nothing: Set adoRS = Nothing
Set adoRS = Nothing: Set cat = Nothing: Set tbl = Nothing
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

[/GPECODE]

Lưu ý là các file cần gộp chỉ để 1 sheet duy nhất nhé.

 

[huynhthanhphong93]

Vấn đề của em cũng tương tự chủ topic nên em xin phép được viết vào đây luôn. Em cần tổng hợp dữ liệu nhiều file vào 1 file Tổng. Ví dụ em có 4 file: với 1 file quản lý có chứa Macro copy data, 2 file hoặc nhiều hơn chứa dữ liệu, 1 file tổng. Khi e click nút gộp trong file quản lý thì data từ 2 file dữ liệu sẽ được copy vào file Tổng. Anh Hai Lúa Miền Tây hướng dẫn giúp em nên chỉnh code của anh lại chỗ nào để code thực hiện như em trình bày với ạ.

 

[Ba Tê]

Vấn đề của em cũng tương tự chủ topic nên em xin phép được viết vào đây luôn. Em cần tổng hợp dữ liệu nhiều file vào 1 file Tổng. Ví dụ em có 4 file: với 1 file quản lý có chứa Macro copy data, 2 file hoặc nhiều hơn chứa dữ liệu, 1 file tổng. Khi e click nút gộp trong file quản lý thì data từ 2 file dữ liệu sẽ được copy vào file Tổng. Anh Hai Lúa Miền Tây hướng dẫn giúp em nên chỉnh code của anh lại chỗ nào để code thực hiện như em trình bày với ạ.

Bạn đọc bài #4, sau khi góp ý, chỉ cần 1 bài có file kèm yêu cầu rõ ràng là anh HLMT giải quyết xong ngay.
Nếu anh HLMT không rảnh thì bạn ráng chờ vậy.
---------------------------------------------------------------------------------------------------
Hổng phải tui "xúi" nghe, tại vì người ta chỉ yêu cầu "Hai Lúa Miền Tây" giúp thôi.

 

[huynhthanhphong93]

Em xin gởi file lên ạ. Do file dữ liệu nhiều nên em up lên host Drive và dẫn link qua mong các Anh xem và giúp em với. https://drive.google.com/folderview?id=0B3j9yYqFsdFpVVdPWHR6VThMSGM&usp=sharing

 

[hic1802]

Bac ơi cho em hỏi : mình chỉ lấy vùng có dữ liệu thì phải làm ntn? e thấy nó copy cả vùng ko có dữ liệu.

Sử dụng code này:

[GPECODE=sql]Sub GopFile()
Dim cn As Object, adoRS As Object, cat As Object, tbl As Object, FileItem As Object
Dim strTableName As String, i As Integer, endR As Integer, strFile As String
Set cn = CreateObject("ADODB.Connection")
Set adoRS = CreateObject("ADODB.Recordset")
Set cat = CreateObject("ADOX.Catalog")
Cells.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=Yes;HDR=No;IMEX=1"";"
.Open
End With
cat.ActiveConnection = cn

If (Right(cat.Tables(0).Name, 1) = "$") Or (Right(cat.Tables(0).Name, 2) = "$'") Then
strTableName = Replace(cat.Tables(0).Name, "'", "")
MsgBox strTableName
With adoRS
.ActiveConnection = cn
.Open "SELECT '" & strFile & "' as [Duong Dan],'" & strTableName & "' as [Ten Sheet], * FROM [" _
& strTableName & "A1:E5000]"
endR = Range("A65000").End(xlUp).Row + 1
Application.ScreenUpdating = False
Range("A" & endR).CopyFromRecordset adoRS
Application.ScreenUpdating = True
.Close
cn.Close
End With
End If
End If
End If
Next
Set cn = Nothing: Set adoRS = Nothing
Set adoRS = Nothing: Set cat = Nothing: Set tbl = Nothing
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

[/GPECODE]

Lưu ý là các file cần gộp chỉ để 1 sheet duy nhất nhé.