Süzülen Alana Yapıştır

[HASAN40]

Merhaba;
Ekteki dosyamda filtre uygulayıp süzdürme yaptığım alana g1 hücresindeki değeri yapıştırmak istiyorum. Ancak arada kalan ve kritere uymayan hücrelere de değer yapıştırılıyor. Bunu nasıl aşabilirim? Denediğim kodlar aşağıdadır ;

Private Sub CommandButton1_Click()
    Dim a As Worksheet
    Set a = Sheets("1")
    a.Range("a1:d" & a.Range("a1048576").End(3).Row).AutoFilter field:=1, Criteria1:="SELİM"
    a.Range("g1").Copy
    a.Range("d2:d" & a.Range("a1048576").End(3).Row).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
End Sub

 

[Murat OSMA]

Bu şekilde bir deneyiniz;

Private Sub CommandButton1_Click()
    Dim a As Worksheet
    Set a = Sheets("1")
    a.Range("a1:d" & a.Range("a1048576").End(3).Row).AutoFilter field:=1, Criteria1:="SELİM"
    a.Range("G1").Copy Range("D2:D" & a.Range("D1048576").End(3).Row).SpecialCells(xlCellTypeVisible)
    Set a = Nothing
End Sub

 

[HASAN40]

Merhaba,
Murat bey, çözümünüz için çok teşekkür ederim.

 

[Murat OSMA]

Merhaba Hasan Bey, rica ederim iyi günler...