Cần help công thức tự động cập nhật dự liệu từ nhiều sheet vào 1 sheet!

[Kelvin123]

Mọi người ơi mình cần công thức để gộp dữ liệu nhiều sheet lại với nhau thành sheet tổng hợp tự động cập nhật khi các sheet chèn dữ liệu mới, nhưng do file excel của mình quá nhiều sheet nên sử dụng Query không tiện. Mọi người có code vba nào có thể giải quyết vần đề này giúp mình không? tks mọi người nhiều.
Mình có file mẫu mọi người giúp mình nhé! Lăng tăng 5 ngày tìm hiểu mà vẫn chưa làm được.hic

 

[snow25]

Mọi người ơi mình cần công thức để gộp dữ liệu nhiều sheet lại với nhau thành sheet tổng hợp tự động cập nhật khi các sheet chèn dữ liệu mới, nhưng do file excel của mình quá nhiều sheet nên sử dụng Query không tiện. Mọi người có code vba nào có thể giải quyết vần đề này giúp mình không? tks mọi người nhiều.
Mình có file mẫu mọi người giúp mình nhé! Lăng tăng 5 ngày tìm hiểu mà vẫn chưa làm được.hic

Ở trên là công thức giữa là Query ở cuối code vba.Tiêu đề là công thức.

 

[Kelvin123]

Ở trên là công thức giữa là Query ở cuối code vba.Tiêu đề là công thức.

Ý mh cần code vba á pro!

 

[CHAOQUAY]

Ý mh cần code vba á pro!

Bạn muốn tổng hợp theo cái gì, STT hay tên hay số điện thoại ...?

 

[Kelvin123]

Bạn muốn tổng hợp theo cái gì, STT hay tên hay số điện thoại ...?

Mình muốn đưa hết dữ liệu sheet danh sách 1, danh sách 2 sang sheet Tổng hợp. Danh sách tổng hợp sẽ tự động thêm dữ liệu khi danh sách 1 hoắc danh sách 2 có dữ liệu mới bạn

 

[phulien1902]

Mình muốn đưa hết dữ liệu sheet danh sách 1, danh sách 2 sang sheet Tổng hợp. Danh sách tổng hợp sẽ tự động thêm dữ liệu khi danh sách 1 hoắc danh sách 2 có dữ liệu mới bạn

Bạn thử:

  Dim Sh As Worksheet, ws As Worksheet, LR&, NR&, Rng As Range
    Application.ScreenUpdating = False
    Set Sh = ActiveWorkbook.Sheets("Tonghop")
    Sh.Cells.Clear: NR = 1
    For Each ws In Worksheets
        If ws.Name <> Sh.Name Then
            LR = ws.Range("A" & ws.Rows.Count).End(3).Row
            If NR = 1 Then
                ws.Range("A4", ws.Cells(4, Columns.Count).End(xlToLeft)).Copy
                Sh.Range("A2").PasteSpecial xlPasteAll: NR = 2
            End If
            ws.Range("A4:F" & LR).Copy
            Sh.Range("A" & NR).PasteSpecial xlPasteValues
            NR = Sh.Range("A" & Sh.Rows.Count).End(xlUp).Row + 1
        End If
    Next
    Worksheets("Tonghop").Range("A1:F1").Value = Worksheets("danhsach1").Range("A3:F3").Value
    Set Rng = Worksheets("Tonghop").Range("A1").CurrentRegion
    Rng.Borders.LineStyle = xlContinuous

 

[Kelvin123]

Bạn thử:

  Dim Sh As Worksheet, ws As Worksheet, LR&, NR&, Rng As Range
    Application.ScreenUpdating = False
    Set Sh = ActiveWorkbook.Sheets("Tonghop")
    Sh.Cells.Clear: NR = 1
    For Each ws In Worksheets
        If ws.Name <> Sh.Name Then
            LR = ws.Range("A" & ws.Rows.Count).End(3).Row
            If NR = 1 Then
                ws.Range("A4", ws.Cells(4, Columns.Count).End(xlToLeft)).Copy
                Sh.Range("A2").PasteSpecial xlPasteAll: NR = 2
            End If
            ws.Range("A4:F" & LR).Copy
            Sh.Range("A" & NR).PasteSpecial xlPasteValues
            NR = Sh.Range("A" & Sh.Rows.Count).End(xlUp).Row + 1
        End If
    Next
    Worksheets("Tonghop").Range("A1:F1").Value = Worksheets("danhsach1").Range("A3:F3").Value
    Set Rng = Worksheets("Tonghop").Range("A1").CurrentRegion
    Rng.Borders.LineStyle = xlContinuous

Cám ơn bạn rất nhiều! Cho mh hỏi thêm là nếu có nhiều sheet hơn nữa ví dụ như danhsach3, danhsach4, danhsach5 thì cần thay đổi công thức gì k bạn???

Bài đã được tự động gộp: 31/7/20

Cám ơn bạn rất nhiều! Cho mh hỏi thêm là nếu có nhiều sheet hơn nữa ví dụ như danhsach3, danhsach4, danhsach5 thì cần thay đổi công thức gì k bạn??? Nếu code trên thì tất cả các sheet dữ liệu đều được đưa vào sheet Tonghop. Nhưng file của mình có nhiều sheet phụ ví dụ như setting, ghi chú thì có cách nào loại nhưng sheet đó ra k bạn????

 

[phulien1902]

Cám ơn bạn rất nhiều! Cho mh hỏi thêm là nếu có nhiều sheet hơn nữa ví dụ như danhsach3, danhsach4, danhsach5 thì cần thay đổi công thức gì k bạn???

Bài đã được tự động gộp: 31/7/20

Nếu dữ liệu trong các Sheets của bạn có cùng cấu trúc như danhsach1, danhsach2,...thì không cần phải thay đổi gì bạn nhé.

 

[Kelvin123]

Cám ơn bạn rất nhiều! Cho mh hỏi thêm là nếu có nhiều sheet hơn nữa ví dụ như danhsach3, danhsach4, danhsach5 thì cần thay đổi công thức gì k bạn???

Bài đã được tự động gộp: 31/7/20

Bạn thử:

  Dim Sh As Worksheet, ws As Worksheet, LR&, NR&, Rng As Range
    Application.ScreenUpdating = False
    Set Sh = ActiveWorkbook.Sheets("Tonghop")
    Sh.Cells.Clear: NR = 1
    For Each ws In Worksheets
        If ws.Name <> Sh.Name Then
            LR = ws.Range("A" & ws.Rows.Count).End(3).Row
            If NR = 1 Then
                ws.Range("A4", ws.Cells(4, Columns.Count).End(xlToLeft)).Copy
                Sh.Range("A2").PasteSpecial xlPasteAll: NR = 2
            End If
            ws.Range("A4:F" & LR).Copy
            Sh.Range("A" & NR).PasteSpecial xlPasteValues
            NR = Sh.Range("A" & Sh.Rows.Count).End(xlUp).Row + 1
        End If
    Next
    Worksheets("Tonghop").Range("A1:F1").Value = Worksheets("danhsach1").Range("A3:F3").Value
    Set Rng = Worksheets("Tonghop").Range("A1").CurrentRegion
    Rng.Borders.LineStyle = xlContinuous

Bạn ơi làm sao để loại các sheet không cần lấy dữ liệu ra vậy bạn???

 

[phulien1902]

Bạn ơi làm sao để loại các sheet không cần lấy dữ liệu ra vậy bạn???

Giả sử bạn không muốn láy dữ liệu ở Shets("abc") và Sheet("xyz"),.... thì bạn tìm đến dòng:
If ws.Name <> Sh.Name Then
và đổi thành:

       If ws.Name <> Sh.Name  and ws.Name<> "abc" and ws.Name<>"xyz" Then

 

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

Mọi người ơi mình cần công thức để gộp dữ liệu nhiều sheet lại với nhau thành sheet tổng hợp tự động cập nhật khi các sheet chèn dữ liệu mới, nhưng do file excel của mình quá nhiều sheet nên sử dụng Query không tiện. Mọi người có code vba nào có thể giải quyết vần đề này giúp mình không? tks mọi người nhiều.
Mình có file mẫu mọi người giúp mình nhé! Lăng tăng 5 ngày tìm hiểu mà vẫn chưa làm được.hic

Thêm một cách nữa cho bạn:

Option Explicit
Sub Gop_Sheet()
    Dim strSQl As String
    Dim sht As Worksheet
    For Each sht In Worksheets
        If sht.CodeName <> "Sheet1" Then
            strSQl = strSQl & " Union All Select *,'" & sht.Name & "' from [" & sht.Name & "$A3:F] where [F1] is not null "
        End If
    Next
    With CreateObject("ADODB.Connection")
        .Open ("Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;HDR=No""")
        Sheet1.Range("A3:R10000").ClearContents
        Sheet1.Range("A3").CopyFromRecordset .Execute(Right(strSQl, Len(strSQl) - 11))
    End With
End Sub

 

[Kelvin123]

Thêm một cách nữa cho bạn:

Option Explicit
Sub Gop_Sheet()
    Dim strSQl As String
    Dim sht As Worksheet
    For Each sht In Worksheets
        If sht.CodeName <> "Sheet1" Then
            strSQl = strSQl & " Union All Select *,'" & sht.Name & "' from [" & sht.Name & "$A3:F] where [F1] is not null "
        End If
    Next
    With CreateObject("ADODB.Connection")
        .Open ("Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;HDR=No""")
        Sheet1.Range("A3:R10000").ClearContents
        Sheet1.Range("A3").CopyFromRecordset .Execute(Right(strSQl, Len(strSQl) - 11))
    End With
End Sub

Em cám ơn nhiều ạ!