Vba coppy dữ liệu sang sheet khác có điều kiện.

[kh0jy3n]

Dear All

Do dữ liệu của em khá nhiều nếu dùng công thức thì file chạy rất chậm mọi người giúp em với.
Giúp em viết Vba coppy dữ từ sheet DU LIEU sang sheet BO PHAN có điều kiện (Bộ phận) chi tiết mn xem file đính kèm ạ.

Tks all !

 

[giaiphap]

Dear All

Do dữ liệu của em khá nhiều nếu dùng công thức thì file chạy rất chậm mọi người giúp em với.
Giúp em viết Vba coppy dữ từ sheet DU LIEU sang sheet BO PHAN có điều kiện (Bộ phận) chi tiết mn xem file đính kèm ạ.

Tks all !

Dùng thử code này cho sheet bộ phận.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address(False, False) = "C1" Then
    Dim aRow%, i%, j%, k%, s$, sArr, dArr
    s = Target.Value
    With Sheet2
        aRow = .Range("K10000").End(xlUp).Row
        If aRow > 2 Then .Range("A3:K" & aRow).ClearContents
        aRow = Sheet1.Range("K10000").End(xlUp).Row
        If aRow < 2 Then Exit Sub
        sArr = Sheet1.Range("A2:K" & aRow).Value
        ReDim dArr(1 To UBound(sArr), 1 To 11)
        k = 0
        For i = 1 To UBound(sArr)
            If sArr(i, 11) = s Then
                k = k + 1
                dArr(k, 1) = k
                For j = 2 To 11
                    dArr(k, j) = sArr(i, j)
                Next j
            End If
        Next i
        If k > 0 Then
            .Range("A3").Resize(k, 11).Value = dArr
        End If
    End With
End If
End Sub