oluşturulan formdaki bazı verilerin altı adet değişkene ait sayfalara kaydedilmesi

[newversion]

İyi akşamlar.Örnek programlar yardımı ile bir formdaki bazı satırların bilgilerini kayıt butonu oluşturarak İZMİR adlı bir sayfaya aktarmayı başardım.Ancak formumdaki açılan pencerelerde 6 değişik şehire ait işyerleri var ve kaydetmek istediğim işyeri bilgilerini ait olduğu şehrin sayfalarına aktarmak istiyorum.Altı adet kayıt butonu oluşturmadan bir buton ile nasıl yapabilirim.

 

[programer]

İşyeri adı bir textbox yada combobox ta yazıyorsa Sheets(TextBox1.Value).select komutu kullanarak sayfayı seçtirirsiniz ve sonra kayıt yaptırırsınız.

 

[Korhan Ayhan]

Selamlar,

Ekteki örnek dosyayı incelermisiniz.

 

[newversion]

özür dilerim kodları ekleyince sorum daha kolay anlaşılabilir

Sub Kaydet()
Set s1 = Sheets("yazi") 'yazi'i s1 olarak tanımla
Set s2 = Sheets("2008") '2008'yi s2 olarak tanımla
s2.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

Sub Sil()
Range("D1823").ClearContents 'D18 D19 D20 D21 D22 D23 hücrelerinin içeriliğini sil
Range("H10").ClearContents 'H10 hücresinin içeriliğini sil
Range("H27:H35").ClearContents 'H27 H28 H29 H30 H31 H32 H33 H34 H35 hücrelerinin içeriliğini sil
Range("I27:I35").ClearContents 'I27 I28 I29 I30 I31 I32 I33 I34 I35 hücrelerinin içeriliğini sil
End Sub
Kodlarım yukarıdaki gibi.Bu kodlarla bilgilerimi 2008 sayfasına aktarabiliyorum.Yazi adlı sayfamda J4 hücresinde il adı var.Bu il adı 6 farklı il olabiliyor.Amacım bir kaydet butonuyla 6 farklı il e ait sayfaya verilerimi gönderebilmek.Teşekkürler

 

[Korhan Ayhan]

Selamlar,

Kaydet isimli makronuzu aşağıdaki şekilde değiştirip denermisiniz.

yazi isimli sayfanın J4 hücresindeki il adını değiştirip makronuzu çalıştırın.

Sub Kaydet()
    Set s1 = Sheets("yazi") 'yazi'i s1 olarak tanımla
[COLOR=red]    Set s2 = s1.[J4] 'yazi sayfasının J4 hücresini s2 olarak tanımla
    Sheets(s2.Text).Select 's2'yi seç
[/COLOR]    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]

Sheets(s2.Text).Select 's2'yi seç satırında hata veriyor.
runtime error "9":
subscript out of range

 

[Korhan Ayhan]

Selamlar,

yazi isimli sayfanızın J4 hücresini kontrol ediniz. O hücrede yazan sayfa ismine ait sayfanız olmayabilir.

 

[newversion]

Selamlar,

yazi isimli sayfanızın J4 hücresini kontrol ediniz. O hücrede yazan sayfa ismine ait sayfanız olmayabilir.
-------------------------------------------------------------------------
Sayın Korhan Ayhan,Sabrınız ve emeğiniz için çok teşekkür ederim.Yardımınız bana ayda 3 gün kazandıracak emin olun.Sağlıcakla kalın.