Sayfa İsmine otomatik veri aktarma

[hatirlabeni]

Merhabalar.

Kod isimli sayfamda personel bilgileri var. (150 personel) Bu personellere ait 6 kalem verim var.
Kod sayfasında bulunan personel sayısı kadar aynı şablondan 150 sayfam var .
Bu Sayfalara kod sayfasındaki ilgili personele ait sayfaya aktarımı kolay bir şekilde aktarmak mümkünmü acaba ?

Örneğin A persoline ait sayfa ismi 1'dir. G6 Hücresine Kod Sayfasından c2 hücresindebulunan bilgisini yazdırmak istiyorum.

Örnek ektedir.

 

[Ziynettin]

Deneyiniz....

Sub test()
Dim s1 As Worksheet, s2 As Worksheet
Dim dc As Object, son As Long, i As Long
Set s1 = Sheets("Kod")
Set dc = CreateObject("scripting.dictionary")
son = s1.Cells(Rows.Count, 3).End(3).Row
If son < 2 Then Exit Sub
a = s1.Range("C1:C" & son).Value
    For i = 2 To UBound(a)
        dc(CStr(i - 1)) = a(i, 1)
    Next i
    For i = 1 To Worksheets.Count
        Set s2 = Sheets(i)
        If dc.exists(s2.Name) Then
            s2.[G6] = dc(s2.Name)
        End If
    Next i
MsgBox "İsimler yazdırıldı.", vbInformation
End Sub

 

[hatirlabeni]

Hocam elinize sağlık Kod tam istediğim gibi çalışıyor .
Diğer bilgilerinde aktarımı için kodu yeniden yazabilir misiniz ?
Kimlik bilgisi iban işe başlama tarihi ve üyelik tarihini.

Teşekkür ederim.

 

[Ziynettin]

Formül olan alanlara verileriniz aktarılıyor.

Sub test_2()
Dim s1 As Worksheet, s2 As Worksheet
Dim dc As Object, son As Long, i As Long
Set s1 = Sheets("Kod")
Set dc = CreateObject("scripting.dictionary")
son = s1.Cells(Rows.Count, 3).End(3).Row
If son < 2 Then Exit Sub
a = s1.Range("C1:H" & son).Value
    For i = 2 To UBound(a)
        dc(CStr(i - 1)) = i
    Next i
    For i = 1 To Worksheets.Count
        Set s2 = Sheets(i)
        If dc.exists(s2.Name) Then
            s2.[G6] = a(dc(s2.Name), 1)
            s2.[L6] = a(dc(s2.Name), 2)
            s2.[S6] = a(dc(s2.Name), 3)
            s2.[AF6] = a(dc(s2.Name), 4)
            s2.[AS6] = a(dc(s2.Name), 5)
        End If
    Next i
MsgBox "Veriler yazdırıldı.", vbInformation
End Sub