çok sayıdaki veriyi tek sayfaya çekmem lazım

[Aytaç]

Merhaba arkadaşlar;
soru olarak yazmam çok zor olacak ama örnekte biraz daha net anlaşılacaktır. Tarih sayfasındaki numaranın karşısına diğer sayfalarda bu numaranın girildiği tarihin gelmesini istiyorum. Örneğin "Tarih" sayfasında A sutünundaki 1982 numarasının karşına "Ön Hazırlık Giriş" sayfasında hangi tarihta giriş yapıldıysa o tarihin "Tarih" sayfasındaki Ön Hazırlık Giriş alanına gelmesini istiyorum mümkünmüdür acaba!!!
Anlaşılmayan birşey olursa ki olacaktır elimden geldiği kadarıyla cevaplamaya çalışacağım.
Şimdiden teşekkürler

 

[AS3434]

Sayın Aytaç

Dosyanız ekte.
Kendi dosyanıza uyarlamadan önce sıhhatli çalışıp çalışmadığını kontrol edin.

Sub aktar()
basla = Time
Dim i, z, x, t As Integer
'Application.ScreenUpdating = False
Set s1 = Sheets("Tarih")
s1.[c3:p500].ClearContents
For i = 2 To [a65536].End(3).Row
 For z = 4 To 13
  If Sheets(z).Name = "Giriş - " & Cells(1, z).Text or  If Sheets(z).Name = "Çıkış - " & Cells(1, z).Text Then
   For t = 2 To [a65536].End(3).Row Step 3
    For x = 2 To 11
     If s1.Cells(i, 1) = Sheets(z).Cells(t, x) Then s1.Cells(i, z) = Sheets(z).Cells(t, 1)
   Next: Next
  End If
 Next: Next
    Set s1 = Nothing
 'Application.ScreenUpdating = True
 bitis = Time
 MsgBox "Aktarma tamamlandı" & Chr(13) & Chr(13) & "Aktarma Süresi: " & Format(bitis - basla, "hh:mm:ss")
End Sub