Makro ile sayfa değeri taşıma

[tekirdagli_0059]

Sayın ustalar;forumda epey bir gözatmama rağmen sorunuma cevap bulamadım;umarım yardımcı olabilirsiniz.
VERİ sayfasında ;
A9 Hücre T.C.Kimlik Nomanuel olarak giriyorum)
B9 hücresinde düşeyara ile Ad-Soyad
C9 hücresinde düşeyara ile pozisyon
d9 hücresinde düşeyara ile fiili görev
e9 hücresinde düşeyara ile eğitim durumu
f9 hücresinde düşeyara ile statü
g9 hücresinde düşeyara ile sınav türü
h9 hücresinde düşeyara ile sınav katılım
ı9 hücresinde sınav başarılı
j9 hücresinde sınav başarısız değerlerim var ve bu A9 (TC Kimlik nosunu)değerini değiştirdikçe tüm veriler değişiyor.
sorunumda burada başlıyor,
oluşturacağım TABLO sayfasında a9 değerini koyacağımız bir buton yardımıyla her değiştiğinde tüm verileri TABLO sayfasına değer olarak aktarmak ve listelemek.yaklaşık 2000 kişilik liste olacak.
Umarım yardımcı olabilirsiniz.
teşekkürler.

 

[hoguz2]

merhaba ,

sayfa isimlerini duzeltip deneyin sayfa3 e a1 den baslayarak asagi dogru sorgulanacak tc numaralarini yazin..

Sub kopyala()
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = False
Dim FROM As Range, TOO As Range
Dim dongu As Integer
Dim s1, s2, s3 As Worksheet
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")
Set s3 = Sheets("Sayfa3")
dongu = s3.Cells(65536, 1).End(xlUp).Row
For i = 1 To dongu
s1.Cells(9, 1) = s3.Cells(i, 1)
Set FROM = Worksheets("Sayfa1").Range("A9:J9")
Set TOO = Worksheets("Sayfa2").Range("A65536").End(xlUp).Offset(1, 0)
FROM.Copy
TOO.PasteSpecial Paste:=xlValues
Next
Set FROM = Nothing
Set TOO = Nothing
Application.ScreenUpdating = True
End Sub

 

[tekirdagli_0059]

merhaba ,

sayfa isimlerini duzeltip deneyin sayfa3 e a1 den baslayarak asagi dogru sorgulanacak tc numaralarini yazin..

Sub kopyala()
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = False
Dim FROM As Range, TOO As Range
Dim dongu As Integer
Dim s1, s2, s3 As Worksheet
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")
Set s3 = Sheets("Sayfa3")
dongu = s3.Cells(65536, 1).End(xlUp).Row
For i = 1 To dongu
s1.Cells(9, 1) = s3.Cells(i, 1)
Set FROM = Worksheets("Sayfa1").Range("A9:J9")
Set TOO = Worksheets("Sayfa2").Range("A65536").End(xlUp).Offset(1, 0)
FROM.Copy
TOO.PasteSpecial Paste:=xlValues
Next
Set FROM = Nothing
Set TOO = Nothing
Application.ScreenUpdating = True
End Sub

hoguz2 ;Emeğinize sağlık ,
Set TOO = Worksheets("Sayfa2").Range("A65536").End(xlUp).Offset(1, 0) işleminde syntax error hatası veriyor.

akşam başlayıp yeni sonlandırdığım basit bir makro ile şuan için istediğim sonuca ulaşabiliyorum;paylaşmak istedim; belki bunun üzerinden geliştirme yapabiliriz.
ilginiz ve desteğiniz için teşekkürler.
Sub Makro1()
'
' Makro1 Makro
'

'
Sheets("VERİ").Select
Range(Selection, Selection.End(xlToRight)).Select
Range("A9:J9").Select
Selection.Copy
Sheets("TABLO").Select
Range("A65535").End(xlUp).Offset(1, 0).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

End Sub