Yetkili İsimlerini Aktar

[omeryılmaz]

Merhaba Arkadaşlar

Formda ara bul konusunda değişik çalışmalar var, çok inceledim ancak sorumu çözemedim

Ekte sunduğum dosya içersin de detaylı anlaşılacağı üzere sorumlu Aile hekimi isimlerini, veri sayfasına ilgili yerlere nasıl aktarabileceğini çözemedim.


Yardımlarınız konusunda şimdiden şükranlarımı sunuyorum..

 

[omeryılmaz]

Çözdüm yine de ilgilenenlere teşekkürler

İhtiyacı olanlara örnek olması için kod

Private Sub CommandButton1_Click()

Set S1 = Sheets("AİLEHEKİMLERİ")
Set s2 = Sheets("VERİ")
s2.[C3:C65536] = Empty
For sat1 = 2 To S1.Cells(65536, "B").End(xlUp).Row
For sat2 = 2 To s2.Cells(65536, "A").End(xlUp).Row
If s2.Cells(sat2, "A") = S1.Cells(sat1, "B") Then
If S1.Cells(sat1, "E") = "Sorumlu Aile Hekimi" Then
s2.Cells(sat2, "B") = Application.WorksheetFunction.Proper(S1.Cells(sat1, "D") )
End If: End If: Next: Next

End Sub

 

[Orion1]

Ömer bey dosyanız ektedir.

Private Sub CommandButton1_Click()
Dim sat As Long, i As Long, sat2 As Long, sh As Worksheet
Sheets("VERİ").Select
Range("A2:B" & Rows.Count).ClearContents
Set sh = Sheets("AİLEHEKİMLERİ")
sat = sh.Cells(Rows.Count, "E").End(xlUp).Row
sat2 = 2
Application.ScreenUpdating = False
For i = 2 To sat
    If UCase(Replace(Replace(sh.Cells(i, "E").Value, "i", "İ"), "ı", "I")) _
            = "SORUMLU AİLE HEKİMİ" Then
            Cells(sat2, "A").Value = sh.Cells(i, "B").Value
            Cells(sat2, "B").Value = sh.Cells(i, "D").Value
            sat2 = sat2 + 1
    End If
Next i
Application.ScreenUpdating = True
MsgBox "İşlem tamamlanmıştır." & vbLf & "evrengizlen@hotmail.com"
End Sub

 

[omeryılmaz]

Hocam size ne kadar şükranlarımı sunsam azdır..

Excel de ne zaman sorunum olsa her zaman yanımda oldunuz..


Sorum yanlış anlaşıldı herhalde,

Yine de size minnettarım...

Görüşmek dileğiyle...

 

[Orion1]

Hocam size ne kadar şükranlarımı sunsam azdır..

Excel de ne zaman sorunum olsa her zaman yanımda oldunuz..

Görüşmek dileğiyle size minnettarım...

Estafurullah.
İyi çalışmalar.