Copy dữ liệu sang sheet khác theo điều kiện

[giaosucan]

Chào các bác, em gặp vấn đề như thế này ạ
Em có 1 sheet gồm 1 table nhiều dòng
Em muốn lọc trong table này những dòng thoả mãn 2 điều kiện cho trước và copy những dòng này sang một sheet khác để tạo ra 1 bảng mới
em có đính kèm file
Trong file này có ở sheet 2 có 1 nút calculate, nếu bấm thì excel sẽ check cột D và I ở sheet 1 xem có dòng nào có 2 ô trùng với ô condition 1 ,và 2 ko thì copy dòng đó sang sheet 2
Thank các bác nhiều ạ

 

[Ba Tê]

Chào các bác, em gặp vấn đề như thế này ạ
Em có 1 sheet gồm 1 table nhiều dòng
Em muốn lọc trong table này những dòng thoả mãn 2 điều kiện cho trước và copy những dòng này sang một sheet khác để tạo ra 1 bảng mới
em có đính kèm file
Trong file này có ở sheet 2 có 1 nút calculate, nếu bấm thì excel sẽ check cột D và I ở sheet 1 xem có dòng nào có 2 ô trùng với ô condition 1 ,và 2 ko thì copy dòng đó sang sheet 2
Thank các bác nhiều ạ

Bạn đưa dữ liệu không có gì giống thật, làm xong nếu đúng kết quả mà không áp dụng được vào dữ liệu thật thì bạn tự xoay sở nhé.

Public Sub GPE()
Dim Rng(), Arr(), I As Long, J As Long, K As Long, Con1 As Variant, Con2 As Variant
With Sheet2
    Con1 = .[I7].Value
    Con2 = .[I8].Value
End With
With Sheet1
    Rng = .Range(.[D5], .[D65000].End(xlUp)).Resize(, 6).Value
End With
ReDim Arr(1 To UBound(Rng, 1), 1 To 6)
    For I = 1 To UBound(Rng, 1)
        If Rng(I, 1) = Con1 Then
            If Rng(I, 6) = Con2 Then
                K = K + 1
                For J = 1 To 6
                    Arr(K, J) = Rng(I, J)
                Next J
            End If
        End If
    Next I
With Sheet2
    .[E10].Resize(1000, 6).ClearContents
    .[E10].Resize(K, 6).Value = Arr
End With
End Sub

 

[giaosucan]

a thank bác nhiều nhé

 

[huutinh85]

Bạn đưa dữ liệu không có gì giống thật, làm xong nếu đúng kết quả mà không áp dụng được vào dữ liệu thật thì bạn tự xoay sở nhé.

Public Sub GPE()
Dim Rng(), Arr(), I As Long, J As Long, K As Long, Con1 As Variant, Con2 As Variant
With Sheet2
    Con1 = .[I7].Value
    Con2 = .[I8].Value
End With
With Sheet1
    Rng = .Range(.[D5], .[D65000].End(xlUp)).Resize(, 6).Value
End With
ReDim Arr(1 To UBound(Rng, 1), 1 To 6)
    For I = 1 To UBound(Rng, 1)
        If Rng(I, 1) = Con1 Then
            If Rng(I, 6) = Con2 Then
                K = K + 1
                For J = 1 To 6
                    Arr(K, J) = Rng(I, J)
                Next J
            End If
        End If
    Next I
With Sheet2
    .[E10].Resize(1000, 6).ClearContents
    .[E10].Resize(K, 6).Value = Arr
End With
End Sub

NHỜ BÁC BATE CHỈNH LẠI CODE GIÙM: mục đích của e là khi lọc thì thỏa mãn 1 trong 2 điều kiện trên thì sẽ lọc và copy. cảm ơn bác