[Xin giúp đỡ] Tách hàng trong sheet có giá trị giống nhau vào 1 sheet

[hakuna7kt]

Chào mọi người, em tự tìm hiểu mà loạn quá rồi , đành lập topic nhờ mọi người gỡ rối, giúp đỡ ạ

Tình hình em có 1 file excel như thế này:



Home
Mục lục: trỏ đến các sheet từng Chi nhánh (ví dụ là 3, sau này e thêm vào sau)
Các sheet Chi nhánh. Trong các sheet Chi nhánh này có cột "Trạng thái", gồm: Trao đổi, báo giá, Test, PO, Thất Bại.

Em muốn hỏi các bác là làm cách nào để tách riêng từng trạng thái, tổng hợp vào các sheet tương ứng: Trao đổi (sheet TD), Báo giá (sheet BG), Test (sheet Test), PO (sheet PO), THất bại (sheet TB)

Các sheet này có cấu trúc là giống nhau.
Em gửi kèm file ạ

Rất mong mọi người giúp em 1 tay, em xin chân thành cảm ơn!

 

[quanluu]

Chào mọi người, em tự tìm hiểu mà loạn quá rồi , đành lập topic nhờ mọi người gỡ rối, giúp đỡ ạ

Tình hình em có 1 file excel như thế này:

View attachment 160377

Home
Mục lục: trỏ đến các sheet từng Chi nhánh (ví dụ là 3, sau này e thêm vào sau)
Các sheet Chi nhánh. Trong các sheet Chi nhánh này có cột "Trạng thái", gồm: Trao đổi, báo giá, Test, PO, Thất Bại.

Em muốn hỏi các bác là làm cách nào để tách riêng từng trạng thái, tổng hợp vào các sheet tương ứng: Trao đổi (sheet TD), Báo giá (sheet BG), Test (sheet Test), PO (sheet PO), THất bại (sheet TB)

Các sheet này có cấu trúc là giống nhau.
Em gửi kèm file ạ

Rất mong mọi người giúp em 1 tay, em xin chân thành cảm ơn!

Bạn thử file của bạn với code này:

Lưu ý: Mình giới hạn với mỗi trạng thái là có 1000 dòng, nếu nhiều hơn thì bạn thay đổi nó.
các trạng thái phải dúng như bạn nói:Trao đổi, Báo giá, Test, PO , Thất bại

Sub tach()
Dim sh As Worksheet
Dim POArr(1 To 1000, 1 To 13), TBArr(1 To 1000, 1 To 13), TDArr(1 To 1000, 1 To 13)
Dim TestArr(1 To 1000, 1 To 13), BGArr(1 To 1000, 1 To 13)
Dim i, j, PO, TB, TD, BG, Test As Integer
Application.ScreenUpdating = False
For Each sh In ThisWorkbook.Sheets
    If Left(sh.Name, 8) = "ChiNhanh" Then
        For i = 6 To sh.Range("A" & Rows.Count).End(3).Row
            If sh.Cells(i, 11) = "PO" Then
                PO = PO + 1
                For j = 1 To 13
                    POArr(PO, j) = sh.Cells(i, j)
                Next
            End If
            If sh.Cells(i, 11) = "Test" Then
                Test = Test + 1
                For j = 1 To 13
                    TestArr(Test, j) = sh.Cells(i, j)
                Next
            End If
            If Left(sh.Cells(i, 11), 2) = "Tr" Then
                TD = TD + 1
                For j = 1 To 13
                    TDArr(TD, j) = sh.Cells(i, j)
                Next
            End If
            
            If Left(sh.Cells(i, 11), 2) = "Th" Then
                TB = TB + 1
                For j = 1 To 13
                    TBArr(TB, j) = sh.Cells(i, j)
                Next
            End If
            
            If Left(sh.Cells(i, 11), 1) = "B" Then
                BG = BG + 1
                For j = 1 To 13
                    BGArr(BG, j) = sh.Cells(i, j)
                Next
            End If
        Next
    End If
Next
If PO > 0 Then Sheets("PO").Range("A6").Resize(PO, 13) = POArr
If Test > 0 Then Sheets("Test").Range("A6").Resize(Test, 13) = TestArr
If TD > 0 Then Sheets("TD").Range("A6").Resize(TD, 13) = TDArr
If TB > 0 Then Sheets("X").Range("A6").Resize(TB, 13) = TBArr
If BG > 0 Then Sheets("BG").Range("A6").Resize(BG, 13) = BGArr
Application.ScreenUpdating = True
End Sub

 

[hakuna7kt]

Vâng, cảm ơn bạn rất nhiều

Mình sẽ tự tìm hiểu để nắm vững cách hoạt động của code.