Giúp em nối dữ liệu của các sheet vào sheet tổng (đã dùng code nhưng bị lỗi) (2 người xem)

[tanmactu]

Chào cả nhà mình rất yếu excell.
Đã học cách nối dữ liệu từ các sheet trên diễn đàn của mình, nhưng bị lỗi là giữa có thêm các hàng tổng không mong muốn và dẫn đến kết quả sai như file đính kèm.
Mong anh em giúp mình với.
Sẳn đây em xin hỏi có thể thêm tùy chọn lọc các dữ liệu theo tháng không? chỉ lọc ở sheet "PGD"
Chúc mừng năm mới! nhé mọi người.
Cám ơn nhiều

 

[be_09]

Chào cả nhà mình rất yếu excell.
Đã học cách nối dữ liệu từ các sheet trên diễn đàn của mình, nhưng bị lỗi là giữa có thêm các hàng tổng không mong muốn và dẫn đến kết quả sai như file đính kèm.
Mong anh em giúp mình với.
Sẳn đây em xin hỏi có thể thêm tùy chọn lọc các dữ liệu theo tháng không? chỉ lọc ở sheet "PGD"
Chúc mừng năm mới! nhé mọi người.
Cám ơn nhiều

Bỏ

Private

Rồi chạy thử lại code xem

 

[tanmactu]

Bỏ

Private

Rồi chạy thử lại code xem

Mình cũng đã thử như bạn nhưng vẫn bị lỗi có 2 dòng "Cộng" (ở dòng 35,36), trong khi mình chỉ cần 1 dòng "Cộng" (ở dòng 14) thôi.

 

[tanmactu]

Private Sub Worksheet_Activate()
Application.ScreenUpdating = False
Dim sh
Rows("15:50000").ClearContents
For Each sh In Worksheets
    If sh.Name <> "PGD" Then
        With sh
[COLOR=#ff0000][B]        If .[a65536].End(3).Row >= 15 Then[/B][/COLOR]
            .Range(.[a15], .[a65536].End(3)).Resize(, 34).Copy _
            [a65536].End(3).Offset(1)
[COLOR=#ff0000][B]       End If[/B][/COLOR]
        End With
    End If
Next
Application.ScreenUpdating = True
End Sub

Cám ơn bạn hpkhuong nhiều. Mình ở Tây Ninh, nếu gần xin mời bạn 1 ly cafe.
Cám ơn và chúc mừng năm mới!

 

[tanmactu]

Cảm ơn thì click trên GPE đó...
Bạn có thể thay code cũ bằng cái này. Cái này chỉ copy value sang thôi...sẽ nhẹ nhàng và chạy nhanh hơn là copy...Và cột thứ tự nó đánh số thứ tự cho bạn luôn

Private Sub Worksheet_Activate()
Dim Ws As Worksheet, Arr, dArr(1 To 65000, 1 To 13), I As Long, J As Long, K As Long
Application.ScreenUpdating = False
For Each Ws In Worksheets
    If Ws.Name <> "PGD" Then
        If Ws.Range("A65000").End(3).Row >= 15 Then
        Arr = Ws.Range("A15", Ws.Range("A65000").End(3)).Resize(, 13).Value
        For I = 1 To UBound(Arr)
            If Arr(I, 1) <> Empty Then
                K = K + 1
                    dArr(K, 1) = K
                For J = 2 To UBound(Arr, 2)
                    dArr(K, J) = Arr(I, J)
                Next J
            End If
        Next I
        End If
    End If
Next Ws
    Range("A15").Resize(65000, 13).ClearContents
    If K Then Range("A15").Resize(K, 13).Value = dArr
Application.ScreenUpdating = True
End Sub

Đúng là chạy nhanh hơn.
Một lần nữa cám ơn bạn