Veri aktarıldı şimdi veriyi geri çağırmam gerek?

[cenkatli]

Merhabalar, herkese kolay gelsin. Sorum şu şekilde olacak. Aşağıdaki şekilde oluşturduğum kod yardımıyla, excel sayfasının belirli hücrelerine girdiğim verileri bir "veri aktar" butonu yardımı ile veri sayfasına taşıyorum. Kodlarda da göreceğiniz gibi P1 e tarih, P2 yede başka bir değer giriyorum. Yapmak istediğim, bu kodlar yardımı ile daha önceden Formlar sayfasından Veri sayfasına aktarılmış verilerden Formlar sayfasında P1 ve P2 ye girilen kritere göre veri sayfasındaki verileri tekrar Formlar sayfasında aktarılan hücrelere geri çağırmak. Üzerinde araştırma yapsamda içinden çıkamadım. Bu konuda fikir ve yardımlarınızı bekliyorum. Teşekkürler



Sub aktar()
Dim sat As Long, sh As Worksheet, k As Byte
Sheets("FORMLAR").Select
Set sh = Sheets("VERİ")
sat = sh.Cells(65536, "A").End(xlUp).Row + 1
If sat >= 65533 Then
MsgBox "Veri sayfasında satır doldu. Kayıt girilemedi.", vbCritical, "uyarı"
Exit Sub
End If
sh.Cells(sat, "A").Value = Range("P1").Value
sh.Cells(sat, "A").NumberFormat = "dd.mm.yyyy"
sh.Cells(sat, "B").Value = Range("P2").Value
For k = 3 To 11
sh.Cells(sat, k).Value = Cells(k + 9, "D").Value

Next
sh.Cells(sat, "G").Value = Cells(12, "F").Value
sh.Cells(sat, "H").Value = Cells(2, "F").Value
sh.Cells(sat, "I").Value = Cells(3, "F").Value
sh.Cells(sat, "J").Value = Cells(4, "F").Value
sh.Cells(sat, "K").Value = Cells(5, "F").Value
sh.Cells(sat, "L").Value = Cells(12, "I").Value
sh.Cells(sat, "M").Value = Cells(13, "I").Value
sh.Cells(sat, "N").Value = Cells(14, "I").Value
sh.Cells(sat, "O").Value = Cells(15, "I").Value
sh.Cells(sat, "P").Value = Cells(16, "I").Value
sh.Cells(sat, "Q").Value = Cells(17, "I").Value
sh.Cells(sat, "R").Value = Cells(30, "D").Value
sh.Cells(sat, "S").Value = Cells(31, "D").Value
sh.Cells(sat, "T").Value = Cells(32, "D").Value
sh.Cells(sat, "U").Value = Cells(33, "D").Value
sh.Cells(sat, "V").Value = Cells(34, "D").Value
sh.Cells(sat, "W").Value = Cells(20, "E").Value
sh.Cells(sat, "X").Value = Cells(21, "E").Value
sh.Cells(sat, "Y").Value = Cells(22, "E").Value
sh.Cells(sat, "Z").Value = Cells(23, "E").Value
sh.Cells(sat, "AA").Value = Cells(20, "H").Value
sh.Cells(sat, "AB").Value = Cells(21, "H").Value
sh.Cells(sat, "AC").Value = Cells(22, "H").Value
sh.Cells(sat, "AD").Value = Cells(23, "H").Value
sh.Cells(sat, "AE").Value = Cells(30, "H").Value
sh.Cells(sat, "AF").Value = Cells(30, "J").Value
sh.Cells(sat, "AH").Value = Cells(30, "M").Value
sh.Cells(sat, "AQ").Value = Cells(31, "M").Value
sh.Cells(sat, "AR").Value = Cells(32, "M").Value
sh.Cells(sat, "AI").Value = Cells(28, "P").Value
sh.Cells(sat, "AJ").Value = Cells(29, "P").Value
sh.Cells(sat, "AK").Value = Cells(30, "P").Value
sh.Cells(sat, "AL").Value = Cells(31, "P").Value
sh.Cells(sat, "AM").Value = Cells(32, "P").Value
sh.Cells(sat, "AN").Value = Cells(33, "P").Value
sh.Cells(sat, "AO").Value = Cells(34, "P").Value
sh.Cells(sat, "AP").Value = Cells(35, "P").Value
Range("D1215,F12,F2:F5,I12:I17,D3034,E20:E23,H20:H23,H30,J30,M30:M32,P2835").ClearContents
End Sub

 

[cenkatli]

sorumu tam olarak ifade edemediğim hissine kapıldığım için örnek dosya ekliyorum. Yardımlarınızı bekliyorum.

 

[halit3]

bu kodu denermisiniz.

Sub çağır()
aranan1 = Sheets("Formlar").Cells(1, "J").Value
aranan2 = Sheets("Formlar").Cells(2, "J").Value

For j = 3 To Worksheets("Veri").[a65536].End(3).Row
bulunan1 = Sheets("Veri").Cells(j, 1).Value
bulunan2 = Sheets("Veri").Cells(j, 2).Value
If aranan1 & aranan2 = bulunan1 & bulunan2 Then
Sheets("Formlar").Cells(1, "C").Value = Sheets("Veri").Cells(j, "H").Value
Sheets("Formlar").Cells(2, "C").Value = Sheets("Veri").Cells(j, "I").Value
Sheets("Formlar").Cells(1, "E").Value = Sheets("Veri").Cells(j, "J").Value
Sheets("Formlar").Cells(5, "B").Value = Sheets("Veri").Cells(j, "C").Value
Sheets("Formlar").Cells(6, "B").Value = Sheets("Veri").Cells(j, "D").Value
Sheets("Formlar").Cells(5, "D").Value = Sheets("Veri").Cells(j, "E").Value
Sheets("Formlar").Cells(5, "F").Value = Sheets("Veri").Cells(j, "G").Value
End If
Next j
MsgBox " Düzenleme Tamanlanmıştır..."
End Sub

 

[cenkatli]

gayet iyi çalışıyor, çok teşekkürler

 

[halit3]

iyi çalışmalar