tổng hợp số lượng 2 tháng thành 1 sheet chung (1 người xem)

[nga xoan]

chào cả nhà!
mình gửi tệp tin và mong mọi người giúp mình cách tổng hợp 2 tháng về 1 sheet báo cáo tổng kết ở sheet3,mình muốn rằng tổng hợp tất cả các model có mặt trong 2 tháng 9+10 và những model giống nào cả 2 tháng đều có thì slương cộng dồn vào, mong các bạn dành chút thời gian để làm giúp mình nhé,
mình cảm ơn cả nhà

 

[SA_DQ]

Xá gì 2 tháng, bạn hãy thử thêm 12 tháng xem sao!

Nhấn vô nút có trên trang 'THop'

 

[nga xoan]

em cảm ơn bác SA_DQ nhưng em không mở được nút " tổng hợp" trong sheet Thop, vì không có macro hay do lí do gì gì đó, bác vui lòng hd em cách làm để tổng hợp lỗi trong 2tháng và cỏ thể sẽ còn tổng hợp lỗi trong mấy năm nữa bác ạ,
cảm ơn bác nhìu

 

[SA_DQ]

nhưng em không mở được nút " tổng hợp" trong sheet Thop, vì không có macro hay do lí do gì gì đó, bác vui lòng hd em cách làm để tổng hợp lỗi trong 2tháng và cỏ thể sẽ còn tổng hợp lỗi trong mấy năm nữa bác ạ,

Có khi macro bị chương trình diệt virus của máy bạn xơi rồi!

Nó nè bạn:

Option Explicit
Sub GPE()
 Dim Sh As Worksheet, Cls As Range, Rng As Range, sRng As Range
 Dim Rws As Long, MyAdd As String
 Const PC As String = " "
1 'Tao Danh Sách Duy Nhát Hàng Hong:'
 Sheets("THop").Select:                [AA1].Value = "Model"
  [AA1].CurrentRegion.Offset(1).ClearContents       'Dòng Lenh Mói Them'
 For Each Sh In ThisWorkbook.Worksheets
   If Sh.Name <> "THop" Then
      With [AA65432].End(xlUp).Offset(1)
         Sh.Range(Sh.[B5], Sh.[B5].End(xlDown)).Copy Destination:=.Offset(0)
      End With
   End If
 Next Sh
 Range("AA1").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=[b4], Unique:=True
2 'Xóa Du Lieu Cu :'
 Rws = [B5].CurrentRegion.Rows.Count
 [c5].Resize(Rws, 3).ClearContents
3 'Duyet Làn Luot Theo Danh Sách Duy Nhát De Tìm Luong Hu Hong Trong Các Trang:'
 For Each Cls In Range([B5], [b60000].End(xlUp))
   For Each Sh In ThisWorkbook.Worksheets
      If Sh.Name <> "THop" Then
         Set Rng = Sh.Range(Sh.[b4], Sh.[b4].End(xlDown))
         Set sRng = Rng.Find(Cls.Value, , xlFormulas, xlWhole)
         If Not sRng Is Nothing Then
            MyAdd = sRng.Address
            Do
               With Cls.Offset(, 1)
                  .Value = .Value + sRng.Offset(, 1).Value
                  If sRng.Offset(, 3).Value <> "" Then
                     .Offset(, 2).Value = .Offset(, 3).Value & PC & Sh.Name & PC & sRng.Offset(, 3).Value
                  End If
               End With
               Set sRng = Rng.FindNext(sRng)
            Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
         End If
      End If
   Next Sh
 Next Cls
'To Màu Cho Vui:'
 Randomize:                Rws = 34 + Int(10 * Rnd())
 [A4].Resize(, 5).Interior.ColorIndex = Rws
End Sub