Koşullu Aktarma

[ocamsul]

arkadaşlar yeni günden herkese iyi sabahlar. benim küçük bir sorum olacak. Pratik eksikliğindenmidir, bir süredir ilgisizliğimdenmidir ama eğer li bir işlemde takıldım Şöyleki;

Ekli çalışma kitabındaki "DURUM" sayfasında eğer "H" hücresine "EVET" yazılır ise o satırın "SONUÇ" sayfasına aktarılmasını nasıl sağlarım? eğer "HAYIR" yazarsada "Durum uygun değil" mesajını nasıl alırım? şimdiden teşekkürler arkadaşlar.

 

[Orion1]

Dosyanız ekte.

Sub aktar()
Dim hcr As Range, alan As Range, son As Long, s2 As Worksheet
Dim s1 As Worksheet
sat = 2
Set s1 = Sheets("DURUM")
Set s2 = Sheets("SONUÇ")
Application.ScreenUpdating = False
s2.Range(s2.Cells(2, "A"), s2.Cells(65536, "H")).ClearContents
Set alan = s1.Range("H2:H" & s1.Cells(65536, "H").End(xlUp).Row)
For Each hcr In alan
    If UCase(Replace(Replace(hcr.Value, "ı", "I"), "i", "İ")) = "EVET" Then
        s2.Cells(sat, "A").Value = sat - 1
        s2.Range(s2.Cells(sat, "B"), s2.Cells(sat, "H")).Value = _
        s1.Range(s1.Cells(hcr.Row, "B"), s1.Cells(hcr.Row, "H")).Value
        sat = sat + 1
        ElseIf UCase(Replace(Replace(hcr.Value, "ı", "I"), "i", "İ")) = "HAYIR" Then
        MsgBox "[ " & hcr.Address(False, False) & " ] Adresinde Bulunan" & vbLf & _
        "[ " & Cells(hcr.Row, "B").Value & " ] Uygun Değil..!!", vbCritical, "DİKKAT"
    End If
Next hcr
Set s1 = Nothing
Set s2 = Nothing
Set alan = Nothing
Application.ScreenUpdating = True
MsgBox "Aktarma İşlemi Tamamlandı..!!", vbOKOnly + vbInformation, Application.UserName
End Sub

 

[ocamsul]

SN: Evren Gizlen, Üsdat çok teşekkür ederim. Uyarlamayı yapayım galiba bir kaç sorum daha olacak. İyi çalışmalar.

 

[ocamsul]

SN:Evren Gizlen, burada "Uygun Değil" mesajını B sütunlarında bulunan örneğin "A uygun değil" şeklinde mesajı nasıl verebiliriz?

 

[Orion1]

SN:Evren Gizlen, burada "Uygun Değil" mesajını B sütunlarında bulunan örneğin "A uygun değil" şeklinde mesajı nasıl verebiliriz?

Dosyayı düzenledim.
2 numaralı mesajdan dosyayı indirebilirsiniz.

 

[ocamsul]

SN: Evren Gizlen, ilginize çok teşekkür. Tam istediğim gibi oldu sağolun.

 

[Orion1]

SN: Evren Gizlen, ilginize çok teşekkür. Tam istediğim gibi oldu sağolun.

Rica ederim.
iyi çalışmalar.

 

[1Al2Ver]

Sayın Evren Gizlen, ben de faydalandım, emeğinize ben de teşekkür ederim.

 

[Orion1]

Sayın Evren Gizlen, ben de faydalandım, emeğinize ben de teşekkür ederim.

Güle güle kullanın.