Hücrede veriyi bul tüm satırı diğer sayfaya kopyala

[ilkerpol]

Merhaba,
Ek örnek dosyada sayfa1 A1 sütununda "yok" içeren hücreleri bulup, yok içeren tüm satırı kopyalayıp sayfa2 A sütununun en son boş satırına yapıştıran makroya ihtiyacım oldu. Beceremedim bir türlü, yardımcı olabilir misiniz?

 

[Necdet]

Merhaba,
Anladığım kadarıyla durumu "yok" olan Ürün Numaralarını aktarmak istiyorsunuz.
Kodda Sayfa indisini kullandım.
Dizi ile çözüm önerdiğim için kodlar karmaşık gelebilir ama hızlıdır.

Sub Deneme()

    Dim arr As Variant, _
        i   As Long, _
        j   As Long
    
    arr = Sayfa1.Range("A1").CurrentRegion.Value
    j = 0
    For i = 2 To UBound(arr, 1)
        If UCase(arr(i, 1)) = "YOK" Then
            j = j + 1
            arr(j, 1) = arr(i, 2)
        End If
    Next i
    
    i = Sayfa2.Cells(Rows.Count, "A").End(3).Row + 1
    Sayfa2.Cells(i, "A").Resize(j, 1) = arr
    
    MsgBox j & " Adet Veri Aktarılmıştır...."
    
End Sub

 

[ilkerpol]

Öncelikle hızlı cevabınız için teşekkür ederim Necdet Bey. Makro İstediğimden fazlasını içeriyor. Fakat sadece hücreyi değil de yok ibaresini içeren tüm satırı kopyalamak istiyorum.

 

[Necdet]

Çelişkiye düştüm, sayfa2 de tek sütun değil de 2 sütun örnek verseyldiniz, ilk mesajda işlem biterdi.

Tüm satırı aktarır.

Sub Deneme()

    Dim arr As Variant, _
        i   As Long, _
        j   As Long, _
        k   As Integer
    
    arr = Sayfa1.Range("A1").CurrentRegion.Value
    j = 0
    For i = 2 To UBound(arr, 1)
        If UCase(arr(i, 1)) = "YOK" Then
            j = j + 1
            For k = LBound(arr, 2) To UBound(arr, 2)
                arr(j, k) = arr(i, k)
            Next k
        End If
    Next i
    
    i = Sayfa2.Cells(Rows.Count, "A").End(3).Row + 1
    Sayfa2.Cells(i, "A").Resize(j, UBound(arr, 2)) = arr
    
    MsgBox j & " Adet Veri Aktarılmıştır...."
    
End Sub

 

[ilkerpol]

Örneği yetersiz vermişim haklısınız, istediğim buydu. Teşekkür ederim ilginize