Bir sayfadaki verileri Diğer Sayfaya otomatik yazdırma

Katılım
30 Eylül 2005
Mesajlar
303
Excel Vers. ve Dili
2003 excel türkçe
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ı
 

Ekli dosyalar

Son düzenleme:
Katılım
3 Nisan 2008
Mesajlar
777
Excel Vers. ve Dili
Office 2007 Türkçe
Altın Üyelik Bitiş Tarihi
04-11-2020
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.
 

Ekli dosyalar

İ

İhsan Tank

Misafir
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.
 
Katılım
30 Eylül 2005
Mesajlar
303
Excel Vers. ve Dili
2003 excel türkçe
Evet personelde bitişik aylar sayfasında ayrı ayrı olacak
 
İ

İhsan Tank

Misafir
Evet dediniz gibi
Merhaba
Boş bir module kopyalayın ve deneyin.
Kod:
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
 
Katılım
30 Eylül 2005
Mesajlar
303
Excel Vers. ve Dili
2003 excel türkçe
Sayın Tank teşekkür ediyorum.
 
Üst