Tạo file tự đông gom các sheet lại thành 1 sheet chung (1 người xem)

[hoaitx]

Chào cả nhà.

Mình có 1 vấn đề cần nhờ sự trợ giúp: mình có 1 file gồm 5 sheet nhập liệu và 1 sheet (mỗi sheet tương ứng với 1 nhan viên) dùng để ghi tổng hợp lại 5 sheet kia. Vấn đề đặt ra là thay vì đợi đến cuối tháng cho các nhân viên kia nhập liệu hết dữ liệu sau đó mình copy thủ công sang sheet total thì giờ mình muốn là tự động sẽ update, liệu có cách nào giải quyết vấn đề này không?

Cảm ơn nhiều.

 

[hoaitx]

Rất mong nhận đc sự trợ giúp từ các bạn

 

[anhtuan2012]

Chào cả nhà.

Mình có 1 vấn đề cần nhờ sự trợ giúp: mình có 1 file gồm 5 sheet nhập liệu và 1 sheet (mỗi sheet tương ứng với 1 nhan viên) dùng để ghi tổng hợp lại 5 sheet kia. Vấn đề đặt ra là thay vì đợi đến cuối tháng cho các nhân viên kia nhập liệu hết dữ liệu sau đó mình copy thủ công sang sheet total thì giờ mình muốn là tự động sẽ update, liệu có cách nào giải quyết vấn đề này không?

Cảm ơn nhiều.

Bạn thử tìm hiểu theo link sau nhé!
http://www.giaiphapexcel.com/dienda...-VLOOKUP-và-INDIRECT-trong-dò-tìm-nhiều-sheet

 

[hoaitx]

Gửi file mà không có dữ liệu giả lập và kết quả thì cũng như không...Mặc dù có tiêu đề...

Muốn nhanh phải có dữ liệu giả lập vào...kết quả ra làm sao...

Mình đã update lại file mẫu. Cảm ơn bạn đã quan tâm.

 

[hoaitx]

Rất cảm ơn bạn, code rất hay

Chạy code này

Option Explicit


Public Sub GPE()
Dim cn As Object, Ax As String, Bx As String
Dim rs As Object, Ws As Worksheet
If Application.Version < 12 Then
    Ax = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="
    Bx = ";Extended Properties=""Excel 8.0;HDR=No;IMEX=1"";"
Else
    Ax = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source="
    Bx = ";Extended Properties=""Excel 12.0;HDR=No;IMEX=1"";"
End If
Set cn = CreateObject("ADODB.Connection")
cn.Open (Ax & ThisWorkbook.FullName & Bx)
Application.ScreenUpdating = False
With Sheets("TOTAL")
.Range("A7", .Range("A65000").End(3)).Resize(, 16).ClearContents
For Each Ws In Worksheets
If Ws.Name <> "TOTAL" Then
    Set rs = cn.Execute("Select * from[" & Ws.Name & "$A7:P] where f2 is not null")
    If Not rs.EOF Then
        .Range("B65000").End(3).Offset(2).Value = Ws.[A1]
        .Range("B65000").End(3).Offset(1, -1).CopyFromRecordset rs
        rs.Close
    End If
End If
Next Ws
End With
cn.Close
Set cn = Nothing
Set rs = Nothing
Application.ScreenUpdating = True
End Sub