Bir sayfadaki verileri Diğer Sayfaya otomatik yazdırma

[mor45]

Personel sayfasında G sutünunda bulunan radyolojide çalışanlardan EVET yazan kişilerin ismini AYLAR sayfamdaki Adı ve Soyadı Yazan yerlere otomatik nasıl yazdırabirim.
Yardımlarınızı bekliyorum.

AYLAR sayfasınta
Adı Soyadı T.C.Kimlik No SSK Sicil No Görevi Öğrenim Durumu Fiili Hizmet Süresi Zammı Kodu
NERMİN DENİZMAN 444444444 555555555 Hemşire Yüksek okul 401101
ESİN EROL 6666666666 7777777777 Sağlık Per Yüksek okul 401101
gibi olmalı

 

[bedri41]

Dosyanızdaki PERSONEL sayfasında adı soyadı tek hücre içerisine yazılmış AYLIK sayfasında Ayrı hücrelerde istiyorsunuz. Hangisi olacak bilemediğim için 2 türlü çözüm yaptım. Dosyanız ilişiktedir.

 

[İhsan Tank]

Personel sayfasında G sutünunda bulunan radyolojide çalışanlardan EVET yazan kişilerin ismini AYIL sayfamdaki Adı ve Soyadı Yazan yerlere otomatik nasıl yazdırabirim.
Yardımlarınızı bekliyorum.

Merhaba
Yalnız bir yerde isim soyisim bir yazılmış bir yerde ayrı bunu nasıl ayırt edeceğiz.

 

[mor45]

Evet personelde bitişik aylar sayfasında ayrı ayrı olacak

 

[İhsan Tank]

Evet personelde bitişik aylar sayfasında ayrı ayrı olacak

Peki bunun son kelimesini mi ayıracakta Soyisme yazacak

 

[mor45]

Peki bunun son kelimesini mi ayıracakta Soyisme yazacak

Evet dediniz gibi

 

[İhsan Tank]

Evet dediniz gibi

Merhaba
Boş bir module kopyalayın ve deneyin.

Option Explicit
Sub radyoloji_aktar_61()
Dim ts, kaplan, trabzonspor, hamsi As Date
Dim bordo, mavi
Set bordo = Sheets("PERSONEL ")
Set mavi = Sheets("AYLIK")
trabzonspor = MsgBox("Aktarıma Başlıyorum", vbYesNo, "Onay")
If trabzonspor = vbNo Then Exit Sub
Application.ScreenUpdating = False
hamsi = Time
For ts = 3 To bordo.Cells(Rows.Count, "A").End(xlUp).Row
bordo.Cells(ts, "J") = Right(bordo.Cells(ts, "A"), Len(bordo.Cells(ts, "A")) - WorksheetFunction _
.Find("*", WorksheetFunction.Substitute(bordo.Cells(ts, "A"), " ", "*", Len(bordo.Cells(ts, "A")) _
- Len(WorksheetFunction.Substitute(bordo.Cells(ts, "A"), " ", "")))))
bordo.Cells(ts, "K") = Len(bordo.Cells(ts, "A")) - Len(bordo.Cells(ts, "J"))
bordo.Cells(ts, "I") = Mid(bordo.Cells(ts, "A"), 1, bordo.Cells(ts, "K") - 1)
Next
mavi.Range("B4:D" & Rows.Count).ClearContents
trabzonspor = 4
Set ts = bordo.Range("G:G").Find("evet", , , xlWhole)
If Not ts Is Nothing Then
kaplan = ts.Address
Do
mavi.Cells(trabzonspor, "C") = bordo.Cells(ts.Row, "I")
mavi.Cells(trabzonspor, "D") = bordo.Cells(ts.Row, "J")
trabzonspor = trabzonspor + 1
Set ts = bordo.Range("G:G").FindNext(ts)
Loop While Not ts Is Nothing And ts.Address <> kaplan
End If
mavi.Range("B4") = 1
mavi.Range("B4:B" & trabzonspor - 1).DataSeries rowcol:=xlColumns, Type:=xlLinear, Date:=xlDay, _
step:=1, Trend:=False
bordo.Range("I:K").ClearContents
Application.ScreenUpdating = True
MsgBox Format(hamsi - Time, "hh:mm:ss") & vbLf _
& "Sürede Aktarım Tamamlandı", , "Bitiş"
End Sub

 

[mor45]

Sayın Tank teşekkür ediyorum.

 

[İhsan Tank]

Sayın Tank teşekkür ediyorum.

Rica ederim
:keyif: