Koşullu verileri özet sayfasına aktarma

[hüseyintok]

Merhaba, ekte ki örnek dosyada özet sayfasına, diğer sayfalarda bulunan 2 koşulu yerine getiren satırların kopyalanarak listelenmek istiyorum. (durum=hayır Tip=aktif olanlar)
Bu konuda yardımcı olabilirmisiniz?

 

[Ziynettin]

Deneyin...

Sub test()
ReDim b(1 To Rows.Count, 1 To 7)
For j = 1 To Worksheets.Count
    Set s1 = Sheets(j)
    If Not s1.Name = "özet" Then
        son = s1.Cells(Rows.Count, 2).End(3).Row
        If son > 3 Then
            a = s1.Range("B3:H" & son).Value
            For i = 2 To UBound(a)
                If a(i, 1) = "HAYIR" And a(i, 2) = "AKTİF" Then
                    say = say + 1
                    For y = 1 To 7
                        b(say, y) = a(i, y)
                    Next y
                End If
            Next i
        End If
    End If
Next j

Application.ScreenUpdating = False
With Sheets("özet")
    .Range("B6:H" & Rows.Count).ClearContents
    .Range("B6:H" & Rows.Count).ClearFormats
    If say > 0 Then
        .[B6].Resize(say, 7) = b
        .[B6].Resize(say, 7).Borders.Color = rgbBrown
    End If
End With
Application.ScreenUpdating = True

MsgBox "İşlem bitti...", vbInformation
End Sub

 

[hüseyintok]

teşekkürler