açılır kutudaki isimlerin sayfasına kayıt

[hakpin]

Kıymetli hocalarım;ve hamitcan hocam
İstihkaklarla ilgili yapmış oduğum ekteki programda, "istihkak giriş" sayfasında oluşturulacak "kaydet" butonuna tıkladığımda sol üsteki açılır kutuda hangi yüklenici seçili ise o yüklenici sayfasına;
Y3 hücresindeki tutarı "E8, ikinci kaydette E9,sırasıyla E19 'a kadar,
O18 hücresindeki tutarı "M8,ikinci kaydette M9,sırasıyla M19 'a kadar,
O 20 hücresindeki tutarı "N8,ikinci kaydette N9,sırasıyla N19 'a kadar,
AJ 25 hücresindeki tutarı "O8,ikinci kaydette O9,sırasıyla O19 'a kadar,
ve bugün tarihinide D8 den ikinci kaydette bir alt satıra D19 a kadar her kayıtta yazmasını istiyorum. Yardımcı olursanız çok sevinirim,çok makbule geçecek,çünkü yüklenici sayısı dosyadakinden hayli fazla. SAYIN HAMİTCAN HOCAM AŞAĞIDAKİ KODU MODÜL 5 E KOPYALADIM ANCAK ACEMİLİĞİMDEN ÇALIŞTIRAMADIM.BİRDE AKTARDIKTAN SONRA KATDEDİP KAYDETMEYECEĞİMİ SORSUN.şİMDİDEN YARDIMCI OLDUĞUNUZ İÇİN TEŞEKKÜR EDERİM. BİLGİNİZE SAĞLIK.
Sub aktar()
Sayfa = [d3]
With Sheets("İstihkak Giriş").Select
.[d8:d19] = Date
.[e8:e19] = [y3]
.[m8:m19] = [o8]
.[n8:n19] = [o20]
.[o8: o19] = [aj25]
End Sub

 

[hamitcan]

Öncelikle, teşekkürler güzel sözleriniz için. Elimden geldiği kadar yardımcı olmaya çalışıyorum forumdaki tüm arkadaşlar gibi.

Gelelim sorunuza;

1.Sorunuzu yeni bir başlıkta açmanıza gerek yok.
2.Yazdığım kodda combo içindeki yüklenici firma ile sayfa isimlerinin aynı olduğunu varsaydım bu (sayfa ismi = yüklenici firma ismi) şekilde değiştirirseniz kod doğru çalışacaktır.
3.Sayfaya bir button ekledim. Ayrıca istediğiniz gibi, butona bastığınızda, aktarım yapmadan önce, size kayıt yapıp yapmak istediğinizi soracak bir msgbox ekledim.

 

[hakpin]

açılır kutudaki isimleri müşteri sayfalarına kaydetme

Sayın Hamitcan hocam,
kodu yazdım çalışıyor.ancak ben yanlış anlattım her halde ,
her kaydetme de önce 8 nolu hücreye,daha sonraki bir kayıtta bir alttaki 9 nolu hücreye gibi,kaydetsin istemiştim.Şu anda aktar dedeğimizde aynı veriyi 8 den 19 a kadar dolduruyor.Size çok oluyorum ama tekrar bakarsanız sevinirim.Teşekkürler.

 

[hamitcan]

Kodu biraz değiştirdim. Aşağıdaki şekilde deneyin.

Sub AKTAR2()
cevap = MsgBox("Bilgileri aktarmak istiyor musunuz?", vbYesNo)
If cevap = vbYes Then
sayfa = [d3]
sOn = WorksheetFunction.CountA(Sheets(sayfa).[d8:d19]) + 1
Sheets(sayfa).Cells(sOn + 7, "d") = Date
Sheets(sayfa).Cells(sOn + 7, "e") = [y3]
Sheets(sayfa).Cells(sOn + 7, "m") = [o8]
Sheets(sayfa).Cells(sOn + 7, "n") = [o20]
Sheets(sayfa).Cells(sOn + 7, "o") = [aj25]

MsgBox "Bilgileriniz aktarılmıştır"
End If
End Sub

 

[hakpin]

açılır kutudaki isimleri müşteri sayfalarına kaydetme

Sayın Hamitcan hocam ,yine ben.
Hoşgörünüze sığınarak yazıyorum.yazmış olduğunuz kodları aynen uyguladım.her şey çok güzel,yalnız modül 2 de başına kesme işareti koyduğum kodu önce sizce uygun müşteri sayfası veya başka bir yere geçici
olarak atıp,İstihkak giriş sayfasıdaki O16,O18,O20,O22 deki değerleri sildikten sonra müşteri sayfasına atabilirmiyiz. "Sheets(sayfa).Cells(sOn + 7, "f") = [o27]" Çünkü mükerrer oluyor.Aynı anda rakam hem oda mevcut hemde müşteri sayfasına eklendiğinden rakam ikiye katlanıyor .Bunu Excel de çözemedim.
Birde müşteri sayfasına gönderirken;Müşteri sayfasındaki c5 hücresi 1 ise 8.satıra 2 ise 9.satıra 3 ise 10 uncu satıra yazması mümkünmü.Yüklenicinin istihkak yapmadığı ay olduğu zaman boş geçiyoruz.Oysa böyle üstten sırayla yazıyor.Eğer ilginerseniz çok memnun olurum.Şimdiden teşekkür ediyor ,kolaylıklar diliyorum

 

[hamitcan]

Aşağıdaki kodu dener misiniz? Umarım doğru anlamışımdır.

Sub AKTAR2()
cevap = MsgBox("Bilgileri aktarmak istiyor musunuz?", vbYesNo)
If cevap = vbYes Then
sayfa = [d3]
sOn = WorksheetFunction.CountA(Sheets(sayfa).[d8:d19]) + 1
Sheets(sayfa).Cells(sOn + 7, "d") = Date
Sheets(sayfa).Cells(sOn + 7, "e") = [y3]
Sheets(sayfa).Cells(sOn + 7, "g") = [o12]
Sheets(sayfa).Cells(sOn + 7, "l") = [az25]
Sheets(sayfa).Cells(sOn + 7, "m") = [o18]
Sheets(sayfa).Cells(sOn + 7, "n") = [o20]
Sheets(sayfa).Cells(sOn + 7, "o") = [aj25]
Sheets(sayfa).Cells(sOn + 7, "p") = [o35]
Sheets(sayfa).Cells(sOn + 7, "j") = [o33]
Sheets(sayfa).Cells(sOn + 7, "aı") = [aj27]

Deger = [o27]
Range("O16:Z16,O18:Z18,O20:Z20,O22:Z22").ClearContents '[027] aktarılmadan önce, [016],[018],[020],[022] siliniyor
ay = Sheets(sayfa).[c5]

Sheets(sayfa).Cells(ay + 7, "f") = Deger

MsgBox "Bilgileriniz aktarılmıştır"
End If
End Sub

 

[hakpin]

açılır kutudaki isimleri müşteri sayfalarına kaydetme

Çok kıymetli Hamitcan Hocam;
İki gündür size tekrar yazmaya utandığımdan elim varmıyor,eğer vaktiniz olurda gönderdiğim proğramı açarak bir daha bakarsanız çok memnun olurum.
İstihkak giriş sayfasında açıklamalarda derdimi anlatmaya çalıştım.Diyeceksinizki baştan hepsini birden neden yazmadın.Haklısınız,iyi hesaplamam lazımdı.Ama kodları kullanınca hataları farkedebildim.Eğer yazmazsanızda siz haklısınız.Her şey için teşekkür ediyorum.Bilginize sağlık.

 

[hamitcan]

Sayın hakpin, çekinmenize gerek yok, bilgim dahilinde yardımcı olmaya çalışırım. Kod da istediğiniz gibi açıklama olan kısımları bir değişkene atadım. Beyaz olan hücreler silindikten sonra bu veriler aktarılacaktır. Fakat kontrol etmedim. Bir eksiklik görürseniz bildirin gerekli düzeltmeleri yapalım. İyi çalışmalar...

Sub AKTAR2()
cevap = MsgBox("İstihkak Onayını yazıcıdan çıkarmadan bilgileri aktarmayınız.Bilgileri aktarmak istiyor musunuz?", vbYesNo)
If cevap = vbYes Then
sayfa = [d3]
sOn = WorksheetFunction.CountA(Sheets(sayfa).[d8:d19]) + 1
ay = Sheets(sayfa).[c5]
Sheets(sayfa).Cells(ay + 7, "d") = Date
Sheets(sayfa).Cells(ay + 7, "e") = [y3]
Sheets(sayfa).Cells(ay + 7, "l") = [az25]
Sheets(sayfa).Cells(ay + 7, "m") = [o18]
Sheets(sayfa).Cells(ay + 7, "n") = [o20]
Sheets(sayfa).Cells(ay + 7, "o") = [aj25]
Sheets(sayfa).Cells(ay + 7, "aı") = [aj27]


deger1 = [o12]
deger2 = [o27]
deger3 = [o33]
deger4 = [o35]
deger5 = [au22]

Range("O16:Z16,O18:Z18,O20:Z20,O22:Z22").ClearContents '[027] aktarılmadan önce, [016],[018],[020],[022] siliniyor


Sheets(sayfa).Cells(ay + 7, "g") = deger1
Sheets(sayfa).Cells(ay + 7, "f") = deger2
Sheets(sayfa).Cells(ay + 7, "j") = deger3
Sheets(sayfa).Cells(ay + 7, "p") = deger4
Sheets(sayfa).Cells(ay + 7, "k") = deger5

MsgBox "Bilgileriniz aktarılmıştır"
End If
End Sub

 

[hakpin]

açılır kutudaki isimleri müşteri sayfalarına kaydetme

Hocam Kodlari Aynen Kopyaladim.İkİ hücrede yine hata Verdİ.dİğerlerİ normal.dosyayi Ekte Tekrar GÖnderİyorum.Giriş sayfasındaki açıklamayı okuduktan sonra aktar deyip kendinizde denerseniz hatayı fark edersiniz.kolay Gelsİn.

 

[hamitcan]

Değişkenlerin yerini değiştirdim. Bir de böyle deneyin.
Sub AKTAR2()
cevap = MsgBox("İstihkak Onayını yazıcıdan çıkarmadan bilgileri aktarmayınız.Bilgileri aktarmak istiyor musunuz?", vbYesNo)
If cevap = vbYes Then
sayfa = [d3]
sOn = WorksheetFunction.CountA(Sheets(sayfa).[d8:d19]) + 1
ay = Sheets(sayfa).[c5]
deger1 = [o12]
deger2 = [l44]
deger3 = [o33]
deger4 = [o35]
deger5 = [au22]

Sheets(sayfa).Cells(ay + 7, "d") = Date
Sheets(sayfa).Cells(ay + 7, "e") = [y3]
Sheets(sayfa).Cells(ay + 7, "l") = [az25]
Sheets(sayfa).Cells(ay + 7, "m") = [o18]
Sheets(sayfa).Cells(ay + 7, "n") = [o20]
Sheets(sayfa).Cells(ay + 7, "o") = [aj25]
Sheets(sayfa).Cells(ay + 7, "aı") = [aj27]



Range("O16:Z16,O18:Z18,O20:Z20,O22:Z22").ClearContents '[027] aktarılmadan önce, [016],[018],[020],[022] siliniyor


Sheets(sayfa).Cells(ay + 7, "g") = deger1
Sheets(sayfa).Cells(ay + 7, "f") = deger2
Sheets(sayfa).Cells(ay + 7, "j") = deger3
Sheets(sayfa).Cells(ay + 7, "p") = deger4
Sheets(sayfa).Cells(ay + 7, "k") = deger5

MsgBox "Bilgileriniz aktarılmıştır"
End If
End Sub