Makro ile aynı ismi bul, listenin sonuna yazdır

[hopeful]

Merhaba,
Makro talebim şu şekilde:

- B kolonunda isimler yer almaktadır. (İsim_1 listesi)

- Satır sayısı değişkendir. (İsim eklemeleri yapılmaktadır).

- Makro ile İsim_1 listesinde ne kadar "Ali" ismi varsa bulsun, İsim_2 listesinde listenin sonuna yazsın. Ali dışındaki isimler aynı sıralama ile İsim_2 ye işlensin.

Yardımınızı rica ederim
iyi çalışmalar,

 

[leumruk]

Selamlar,

Private Sub Worksheet_Change(ByVal Target As Range)
sonsat = Cells(Rows.Count, 2).End(3).Row
If Intersect(Target, Range("b2:b" & sonsat)) Is Nothing Then Exit Sub
Range("d2:d" & sonsat).ClearContents
sat = 1
For x = 2 To sonsat
If Cells(x, 2) <> "Ali" Then
sat = sat + 1
Cells(sat, 4) = Cells(x, 2)
End If
Next
dsat = Cells(Rows.Count, 4).End(3).Row + 1
Range("d" & dsat & ":d" & sonsat) = "Ali"
End Sub

 

[hopeful]

Sn leumruk teşekkür ederim.