Koşula göre veri aktarımı

[asi_kartal]

slm arkadaşlar ekli dosyada sayfa2'deki aktar butona tıklayınca sayfa1 D sutünunda "aktif" yazanların ad soyad gibi bilgilerin sayfa2 deki ilgili yerlere aktarmasını istiyorum yardımlarınızı bekliyorum.

 

[Emir Hüseyin Çoban]

. . .

Sub kod_Aktar()
Application.ScreenUpdating = False
Dim S1 As Worksheet
Dim S2 As Worksheet
Set S1 = Sheets("SAYFA1")
Set S2 = Sheets("SAYFA2")

S1_son_sat = S1.[b65536].End(3).Row
a = 4
b = 1
For i = 2 To S1_son_sat

If S1.Cells(i, "d") = "AKTİF" Then
S2.Cells(a, "c") = S1.Cells(i, "c")
S2.Cells(a, "d") = S1.Cells(i, "b")
S2.Cells(a, "b") = b
b = b + 1
a = a + 1

Else
End If
Next i

Application.ScreenUpdating = True
MsgBox " B İ T T İ "
End Sub

. . .

 

[asi_kartal]

hüseyin hocam çok sağol teşekkür ederim.