Belirlenen kritere göre sütuna değer yazdırma

[ahzola]

Merhabalar

Tüm forum ahalisine iyi hafta sonları dilerim.

B4 hücresinde belirlediğim kritere göre
A sütundaki verileri süzecek ve D sütununa belirlediğim
verileri yazacak bir makro istemekteyim.
yardımlarınızı bekliyorum.

saygılarımla.

 

[Orion1]

Konu başlığınızı değiştiriniz.Konuya uygun bir başlık yapınız.
Dosyanız ektedir..

Sub Turkiye59()
Dim sat As Long, i As Long
sat = Cells(Rows.Count, "A").End(xlUp).Row
Range("D6:D" & Rows.Count).Clear
Application.ScreenUpdating = False
For i = 6 To sat
    If LCase(Replace(Cells(i, "A").Value, "İ", "i")) = "türkiye" Then
        Cells(i, "D").Value = "Yerli"
        Else
        Cells(i, "D").Value = "İthal"
    End If
Next i
Application.ScreenUpdating = True
MsgBox "İşlem tamamlanmıştır." & vbLf & "evrengizlen@hotmail.com", _
    vbOKOnly + vbInformation, Application.UserName

        
End Sub

 

[ahzola]

Teşekkür ederim.
Sayın Orion

ellerinize sağlık.

Başlık hususunda daha dikkatli olacağım.