Tách dữ liệu ra từng sheet theo điều kiện. (2 người xem)

[tuanhs710]

Chào Anh/Chị,
làm thế nào để lọc dữ liệu ra theo từng sheet theo điều kiện được ah ?

như file đính kèm, trong sheet Sum là tổng hợp tất cả mặt hàng theo nơi cung cấp, bây giờ tách ra tứng sheets nơi cung cấp.
ví dụ: nơi cung cấp là Bình Phước thì chỉ lấy sản phẩm ở Bình Phước, tương tự với Bình Dương, Hà Nội và Đà Lạt.

Mong được Anh/Chị hướng dẫn, cảm ơn.

 

[vanthinh3101]

Chào Anh/Chị,
làm thế nào để lọc dữ liệu ra theo từng sheet theo điều kiện được ah ?

như file đính kèm, trong sheet Sum là tổng hợp tất cả mặt hàng theo nơi cung cấp, bây giờ tách ra tứng sheets nơi cung cấp.
ví dụ: nơi cung cấp là Bình Phước thì chỉ lấy sản phẩm ở Bình Phước, tương tự với Bình Dương, Hà Nội và Đà Lạt.

Mong được Anh/Chị hướng dẫn, cảm ơn.

Bạn dùng code sau:

Sub Tach_sheets()
    Dim I As Long, J As Long, K As Long, Ws As Worksheet
    Dim Dic As Object, sArr(), tArr, dArr()
    
    sArr() = Sheet1.Range("C2", Sheet1.Range("C2").End(xlDown)).Offset(, -1).Resize(, 2).Value
    
    Set Dic = CreateObject("Scripting.Dictionary")
    For I = 1 To UBound(sArr, 1)
        If Not Dic.exists(sArr(I, 2)) Then Dic.Add sArr(I, 2), ""
    Next I
    
    tArr = Dic.keys
    For J = 0 To UBound(tArr)
        K = 0
        ReDim dArr(1 To UBound(sArr, 1), 1 To 3)
        Set Ws = Worksheets.Add(, Sheet1)
        Ws.Name = tArr(J)
        Sheet1.Range("A1:C1").Copy Ws.Range("A1")
        For I = 1 To UBound(sArr, 1)
            If sArr(I, 2) = tArr(J) Then
                K = K + 1
                dArr(K, 1) = K: dArr(K, 2) = sArr(I, 1): dArr(K, 3) = sArr(I, 2)
            End If
        Next I
        Ws.Range("A2").Resize(K, 3) = dArr
        Erase dArr
        Ws.UsedRange.Borders.LineStyle = 1
        Ws.Columns("A:C").AutoFit
    Next J
    MsgBox "Done", vbInformation, "GPE"
End Sub