Değişik sayfalardan bir sayfala hücre aktarımı

[mehmet karatay]

Site üyelerine saygılarımı sunuyorum. Yaklaşık 3 aydır siteye giriyorum. Çok faydasını görüyorum. Tam olmasada bazı şeyleri kendim yapar hale gelmeye bayladım. Ama Üstadlarımdan yine bir yardım isteyeceğim. Açıklamayı ekteki evrakta yaptım. Üstadlarımın yardımını bekliyorum. Şimdiden teşekkür ederim. Saygılarımla.

 

[Necdet]

Merhaba,

Aşağıdaki kodları ThisWorkbook un içine kopyalayınız. Ben Çift tıklamaya bağladım A1:O1 içinde herhangi bir hücreye çift tıklarsınız veriler "TESLİM EDİLEN" sayfasına aktarılacaktır.

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, [A1:O1]) Is Nothing Then Exit Sub
If ActiveSheet.Name = "TESLİM EDİLEN" Then Exit Sub
Set s1 = Sheets("TESLİM EDİLEN")
SatırNo = s1.[A65536].End(3).Row + 1
s1.Cells(SatırNo, "A") = [A1]
s1.Cells(SatırNo, "B") = [J1]
s1.Cells(SatırNo, "C") = [L1]
End Sub

 

[ünal karadavut]

mehmet kardeşim
istediğin evrak kayıt programı ise yardımcı olayım,
yok birşeyler öğrenmekse allah zihnini artırsın.

 

[mehmet karatay]

Sy ünal karadavut allah razı olsun, ben kendime göre düşeyara yöndemi ile bir evrak kayıt programı yapmaya çalışıyorum. Evrakları teslim ederken tek tek yazmam gerekiyor. Ben bundan kurtulmak ve çalışmış olduğum yerde daha çok verimli olmak ve aynı zamanda sayenizde birşeyler öğrenmek istiyorum. Saygılar.

 

[mehmet karatay]

Necdet_Yesertener verdiğiniz formülü denedim ama aktarma yapmadı. Ayrıca göndermiş olduğum örnekte 6 sayfadan hangisinde kayıt yaparsam EVRAK TESLİM sayfasına alt alta atması gerekiyor. Her sayfada değişik yerlerden veriler aktarılması geretiyor. Saygılarımla.

 

[ünal karadavut]

evrak kayıt

mehmet kardeşim excel bilgi sitesi ( bankası) sayesinde çok şey öğrendim. seninle paylaşmak istiyorum.
ben resmi kurumda çalışıyorum. evrakı verirken zimmet karşılığı veriyorum. bu çalışma inşallah işine yarar.
tekrar bunu yapmamda emeği geçenlerden allah razı olsun.
(anlamadığın yerleri dilimin döndüğü kadar anlatayım.)

 

[mehmet karatay]

ünal karadavut Yardımların için allah razı olsun. bende resmi bir kurumda çalışıyorum. Buradaki amacım devletime ve milletime daha iyi ve daha hızlı hizmet etmek. Göndermiş olduğum dosyamda eksiklerimi tamamlamak amacındayım. Saygılarımla.

 

[mehmet karatay]

ünal karadavut göndermiş olduğum örnekle bana yardımcı olma ilkanın olursa çok sevinirim. Biliyorsun evrakları alırkende verirkende zimmetli vermemiz gerekiyor. Benim çalıştığım yerde evrak akışı çok olduğundan gördermiş olduğum örnek bana çok lazım. 6 sayfaya kaydettiğim evraklar EVRAK TESLİM sayfasına kaydedilirse benim işim dahada hızlanacak. Göndermiş olduğun evrakta da bana yarayan çok şeyler var. Ayrıca ilgin için çok teşekkür ederim. Allah razı olsun.

 

[ünal karadavut]

e-mailini verirsen oradan anlatayım.
siteyi meşgul etmeyelim.
benimki
bozokluunal@hotmail.com

 

[Necdet]

Sayın mehmet karatay,

Her sayfada girilen değerleri çift tıkladığınızda ilgili sayfaya aktarıyor. Sorunuz böyle idi.

Ama..

Sonradan incelediğimde diğer sayfalarda başka sütunların aktarımı söz konusu imiş, oysa ilk sayfada öyle demiyordunuz.

Bu durumda ThisWorkbook ta tek bir işlem yerine (incelenirse burada da olabilir) her sayfaya bir kod yazmak gerek.

 

[mehmet karatay]

ünal karadavut söylediklerini yazdım. Başka ne yapmam gerektiğini alamadım.

 

[mehmet karatay]

ünal karadavut e-mailim n_dinc_42@hotmail.com saygılarımla.

 

[Necdet]

Merhaba,

Her ne kadar benim yardımımı pek istemeseniz bile, hizmette sınır tanımam

Sanki "İHZ" sayfasında aktarılacak sütun bana garip geldi, onu siz düzeltirsiniz artık.

Birinci satırda herhangi bir hücreye çift tıklamada kod devreye girer.

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, [A1:O1]) Is Nothing Then Exit Sub
If ActiveSheet.Name = "TESLİM EDİLEN" Then Exit Sub
Set s1 = Sheets("TESLİM EDİLEN")
SatırNo = s1.[A65536].End(3).Row + 1
Select Case ActiveSheet.Name
    Case "V"
        Değer1 = [J1]
        Değer2 = [L1]
    Case "MÜZ"
        Değer1 = [K1]
        Değer2 = [M1]
    Case "İD"
        Değer1 = [H1]
        Değer2 = [J1]
    Case "YK"
        Değer1 = [L1]
        Değer2 = [J1]
    Case "İHZ"
        Değer1 = [L1]
        Değer2 = [M1]
    Case "ASK"
        Değer1 = [H1]
        Değer2 = [11]
End Select
s1.Cells(SatırNo, "A") = [A1]
s1.Cells(SatırNo, "B") = Değer1
s1.Cells(SatırNo, "C") = Değer2
End Sub

 

[mehmet karatay]

Necdet_Yesertener arkadaşım allah razı olsun kenislikle kabul etmeme gibi birşey olmaz olamazda. eğer bir yanlışım olduysa özürdilerim. siz tüm arkadaşlara yardım etsin veya etmesin saygılarımı sunarım.

 

[mehmet karatay]

Necdet_Yesertener verdiğiniz formülü uyguladım ama aktarma yapmıyor. Ben Yanlış yapıyor olabilirim belkide gönderdiğim dosyada yaparsan memnun olurum. Ayrıca bu işlem bir bütonla daha iyi olmazmı acaba. Saygılarımla.

 

[Necdet]

Sayın mehmet karatay,

Zaten dosya üzerinde yapıp denedikten sonra kodları gönderiyorum. Dosyayı zipleyip göndereyim dedim ama bir türlü gönderemedim.

Kodları ThisWorkbook a kopyaladıktan sonra ilgili sayfada 1. satırda çift tıklıyor musunuz?

 

[mehmet karatay]

Sayın Necdet_Yesertener yapmış olduğun formülü denedim çok güzel olmuş. 1. satıra çift tıklayınca işlemi yapıyor. Ben eksik anlatmışım. Yeni farkına vardım. aktarılacak olan sayfalarda sürekli kayıt yapılıyor. Birinci satıra tıkladığımda sadece o satırı alıyor. 1,2,3.4 ve 5. ........ diğer satırlarıda alması gerekiyor. Ayrıca Yardımların için allah razı olsun.

 

[Necdet]

Merhaba,

B, C dediğiniz sütun adları, ama siz satır diyorsunuz, ne anlamam gerekir son açıklamanızdan?

 

[mehmet karatay]

Sayın Necdet_Yesertener kusura bakma yanlış yazmışım. 2,3,4 ve 5. ....... satırlar.

 

[Necdet]

Merhaba,

Bulunduğunuz Sayfada bulunduğunuz satırda çift tıklarsanız ilgili sayfaya aktarım şeklinde değiştirdim. Deneyiniz. Hücreyi belirlerken bazen Range, bazende Cells kullandım, amacım ikisi de aynı şey olduğu için değişik yazım kuralını öğeniniz içindir.

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, [A:O]) Is Nothing Then Exit Sub
If ActiveSheet.Name = "TESLİM EDİLEN" Then Exit Sub
Set s1 = Sheets("TESLİM EDİLEN")
SatırNo = s1.[A65536].End(3).Row + 1
Satır = Target.Row
Select Case ActiveSheet.Name
    Case "V"
        Değer1 = Range("J" & Satır)
        Değer2 = Range("L" & Satır)
    Case "MÜZ"
        Değer1 = Range("K" & Satır)
        Değer2 = Range("M" & Satır)
    Case "İD"
        Değer1 = Range("H" & Satır)
        Değer2 = Range("J" & Satır)
    Case "YK"
        Değer1 = Range("L" & Satır)
        Değer2 = Cells(Satır, "J")
    Case "İHZ"
        Değer1 = Cells(Satır, "L")
        Değer2 = Cells(Satır, "M")
    Case "ASK"
        Değer1 = Cells(Satır, "H")
        Değer2 = Cells(Satır, "L")
End Select
s1.Cells(SatırNo, "A") = Cells(Satır, "A")
s1.Cells(SatırNo, "B") = Değer1
s1.Cells(SatırNo, "C") = Değer2
End Sub