formdaki il seçeneğine göre verileri o ilin sayfasındaki son satıra kaydettikten

[newversion]

formdaki il seçeneğine göre verileri kaydet butonu yardımıyla o ilin sayfasındaki son satıra kaydettikten sonra(buraya kadar tamam) o satırdaki daha önceden yazılmış bulunan tarih ve no hücresini formdaki bir hücreye yapıştırmak istiyorum.Yardımınızı rica ederim.Kodlarım;
Sub Kaydet()
Set s1 = Sheets("yazi") 'yazi'i s1 olarak tanımla
Set s2 = s1.[J4] 'yazi sayfasının J4 hücresini s2 olarak tanımla
Sheets(s2.Text).Select 's2'yi seç
Range("A1").Select 'a1 hücresini seç
Do While Not IsEmpty(ActiveCell) 'Aktif hücre boş oluncaya kadar
ActiveCell.Offset(1, 0).Select 'bir alt hücreyi
Loop 'seç
ActiveCell.Value = s1.Range("J11") 'Aktif boş hücreye Sayfa1'deki J11 hücresini yaz
ActiveCell.Offset(0, 1).Value = s1.Range("J13") 'Aktif hücrenin 1 sağ hücresinne J13 hücresini yaz
ActiveCell.Offset(0, 4).Value = s1.Range("F22") 'Aktif hücrenin 4 sağ hücresinne F22 hücresini yaz
ActiveCell.Offset(0, 5).Value = s1.Range("G22") 'Aktif hücrenin 5 sağ hücresinne G22 hücresini yaz
ActiveCell.Offset(0, 6).Value = s1.Range("J6") 'Aktif hücrenin 6 sağ hücresinne J6 hücresini yaz
ActiveCell.Offset(0, 7).Value = s1.Range("J2") 'Aktif hücrenin 7 sağ hücresinne J2 hücresini yaz
ActiveCell.Offset(0, 8).Value = s1.Range("F28") 'Aktif hücrenin 8 sağ hücresinne F28 hücresini yaz
ActiveCell.Offset(0, 9).Value = s1.Range("D31") 'Aktif hücrenin 9 sağ hücresinne D31 hücresini yaz
ActiveCell.Offset(0, 10).Value = s1.Range("D35") 'Aktif hücrenin 10 sağ hücresinne D35 hücresini yaz
s1.Select 'yazi'i seç
Range("A2").Select 'a2 hücresini seç
MsgBox "Kayıt İşlemi Tamamlandı." 'Uyarı mesajı ver
Set s1 = Nothing 'Sayfa tanımlamalarını kaldır.
Set s2 = Nothing 'Sayfa tanımlamalarını kaldır.
End Sub

 

[newversion]

formdaki bir hücredeki veriye göre 6 değişik sayfadan birinin en alt satırına kayıt yapıldıktan sonra,kayıt yapılan satıra daha önceden girilmiş olan tarih ve no nun formdaki G4 hücresine yazılması gerekiyor.

 

[Recep İpek]

Sorunuzda bir eksiklik var gibi.

Peki formdaki verilerinizi siz seçtiğiniz il sayfasının son boş satıra kaydetmiyor musunuz?
Dolayısıyla burada tarih ve no bilgilerinin olmaması gerekiyor.

Mümkünse küçük bir örnek dosya eklerseniz kısa zamanda çözüme kavuşursunuz.

 

[newversion]

yardım

Seçtiğim il sayfasında C ve D sütunlarında daha önceden girilmiş sabit veriler var(mucip tarihi ve mucip no)Yukarıdaki kodları kısaltarak bir örnek dosya ekliyorum.Yardımlarınızı rica ediyorum.

 

[newversion]

acil yardım

Cevaplayacak kimse yok mu?Bana çok gerekli gerçekten.

 

[Recep İpek]

Kodlarınıza aşağıdaki satırları ilave ediniz.

Sub Kaydet()
    Set s1 = Sheets("yazi") 'yazi'i s1 olarak tanımla
    Set s2 = s1.[C18] 'yazi sayfasının C18 hücresini s2 olarak tanımla
    Sheets(s2.Text).Select 's2'yi seç
    Range("A1").Select 'a1 hücresini seç
    Do While Not IsEmpty(ActiveCell) 'Aktif hücre boş oluncaya kadar
    ActiveCell.Offset(1, 0).Select 'bir alt hücreyi
    Loop 'seç
    ActiveCell.Value = s1.Range("C12") 'Aktif boş hücreye Sayfa1'deki C12 hücresini yaz
    ActiveCell.Offset(0, 1).Value = s1.Range("C13") 'Aktif hücrenin 1 sağ hücresinne C13 hücresini yaz
    ActiveCell.Offset(0, 4).Value = s1.Range("C14") 'Aktif hücrenin 4 sağ hücresinne C14 hücresini yaz
    ActiveCell.Offset(0, 5).Value = s1.Range("C15") 'Aktif hücrenin 5 sağ hücresinne C15 hücresini yaz
    ActiveCell.Offset(0, 6).Value = s1.Range("C16") 'Aktif hücrenin 6 sağ hücresinne C16 hücresini yaz
    ActiveCell.Offset(0, 7).Value = s1.Range("C17") 'Aktif hücrenin 7 sağ hücresinne C17 hücresini yaz
    [COLOR=blue]s1.Range("e7").Value = ActiveCell.Offset(0, 2).Value
    s1.Range("e8").Value = ActiveCell.Offset(0, 3).Value
[/COLOR]    s1.Select 'yazi'i seç
    Range("A2").Select 'a2 hücresini seç
    [COLOR=blue]ActiveWindow.SelectedSheets.PrintPreview
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True[/COLOR]
    MsgBox "Kayıt İşlemi Tamamlandı." 'Uyarı mesajı ver
    Set s1 = Nothing 'Sayfa tanımlamalarını kaldır.
    Set s2 = Nothing 'Sayfa tanımlamalarını kaldır.
End Sub

 

[newversion]

çok teşekkür ederim.

Emeğiniz için çok teşekkür ederim üstadım.İyi ki varsınız.

 

[Recep İpek]

Önemli değil.