Makro ile tabloyu gönderemiyorum ?

[abbasonline]

Dosyadaki makroya yardımcı olurmusunuz. TEŞEKKÜRLER.

 

[abbasonline]

dosyaya yardımcı olabilirmisiniz.

makrolar ile ilgili

 

[abbasonline]

dosyaya yardımcı olurmusunuz makroda hata var.

 

[abbasonline]

makro ile tobloyuda göndermek istiyorum

 

[Orion1]

Dosyanız ektedir.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim alan As Byte, sh As Worksheet
    If Intersect(Target, Range("A2:D2")) Is Nothing Then Exit Sub
    Cancel = True
    If Target.Address = "$A$2" Then
        alan = 3
        Set sh = Sheets("RAPOR")
        ElseIf Target.Address = "$B$2" Then
        alan = 8
        Set sh = Sheets("RAPOR1")
        ElseIf Target.Address = "$D$2" Then
        alan = 5
        Set sh = Sheets("RAPOR3")
        ElseIf Target.Address = "$C$2" Then
        alan = 4
        Set sh = Sheets("RAPOR2")
    End If
    
    If Target <> "" Then
    sh.Columns("A:BV").ClearContents
    Range("[B][COLOR="Red"]A6[/COLOR][/B]").AutoFilter
    Range("[B][COLOR="Red"]A6[/COLOR][/B]").AutoFilter Field:=alan, Criteria1:="=*" & Target.Value & "*"
    Range("[B][COLOR="Red"]A6[/COLOR][/B]").CurrentRegion.Copy sh.Range("[B][COLOR="Red"]A6[/COLOR][/B]")
    Range("[B][COLOR="Red"]A6[/COLOR][/B]").AutoFilter
    sh.Select
    sh.Cells.EntireColumn.AutoFit
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
    End If
    Set sh = Nothing
End Sub

 

[abbasonline]

Evren bey ilgilendiğiniz için teşekkür ederim, sarı renkli hüçreleri çift tıkladığımda sayfa 1 de bulunan tablo yine rapor sayfasına olduğu gibi geçmiyor, sadece alttaki rakamlar geçiyor, acaba tabloyu rapor sayfalarına ayrı ayrı kendimiz ellemi yapmamız gerekir.

 

[abbasonline]

rapor sayfalarına tabloyu sayfa 1 den kopyalayıp yapıştırırsak kod girilen sayfada (Range("A6").CurrentRegion.Copy sh.Range("A6")) burası sarı renkli oluyor ve hata veriyor.

 

[Orion1]

Evren bey ilgilendiğiniz için teşekkür ederim, sarı renkli hüçreleri çift tıkladığımda sayfa 1 de bulunan tablo yine rapor sayfasına olduğu gibi geçmiyor, sadece alttaki rakamlar geçiyor, acaba tabloyu rapor sayfalarına ayrı ayrı kendimiz ellemi yapmamız gerekir.

A2'ye çift tıklarsanız Rapor sayfasına geçer.
Siz istemedibnizmi bu kodları.
Galiba ne istediğinizi unutunuz.
A2=Rapor
B2=Rapor1
D2=Rapor3
C2=Rapor2

 

[Orion1]

rapor sayfalarına tabloyu sayfa 1 den kopyalayıp yapıştırırsak kod girilen sayfada (Range("A6").CurrentRegion.Copy sh.Range("A6")) burası sarı renkli oluyor ve hata veriyor.

Kopyalayıp yapıştırmanıza gerek yok.
Eğer benim yoladığım dosyayı çalıştırırsanız kodlar gayet güzel çalışıyor.
Ama siz bu kodları alıp başka bir yerde kullanıyorsanız tablo yerinize göre kodlar hata verbilir ve çalışmayabilir.
Tablonıunda başlıklarının ayni yerde olması gerekiyor.
Benim yolladığım dosyada ben denedim.Kodlar gayet güzel çalışıyor.

 

[abbasonline]

Evren bey kodlar düzgün çalışıyor ancak, sayfa 1 de (I2) başlayan ve (TABLO) yazılı hücrelerin bulunduğu şekilmi diyelim çizimmi diyelim, bu tablo RAPOR sayfalarında gözükmüyor, Tablonun altındaki rakamlar olduğu gibi RAPOR sayfalarına gidiyor ancak hangi rakam neyin nesi olduğunu, bahse konu tablo olmayınca anlaşılmıyor, sadece rakamlar gözüküyor. İlginiz için Teşekkür ederim.

 

[abbasonline]

Acaba süzme işlemi A6 dan başladığı için olabilirmi, çünkü tablo I2-I6 ve BW2-BW6 arasında bulunuyor.

 

[Orion1]

Acaba süzme işlemi A6 dan başladığı için olabilirmi, çünkü tablo I2-I6 ve BW2-BW6 arasında bulunuyor.

Başka bir dosyada kullancaksanız tabii ki bu kodları oradaki konuma göre uyarlamanız lazım.
Kodlar benim yolladığı dosyada çalışıyorda sizin uyarlamaya çalıştığınız dosyada çalışmıyorsa kodlar hatalı diyemezsiniz.Bu durumda hatayı kendinizde arayacaksınız.

 

[abbasonline]

Evren bey teşekkürler sağolun.

 

[abbasonline]

Evren bey kusura bakmayın;

sizin gönderdiğiniz dosyadaki kodları hiç bir yere uygulamadan açıyorum ve alttaki resimlerdeki gibi oluyor yine bahse konu çizelge rapor sayfalarında gözükmüyor.

 

[Orion1]

Sorduğunuz sorudaki yerleşim ile buradaki farklılar.
Orada başka soruyorsunuz buradaki ise başka türlü.Sonra olmuyor tabii.Uyarlayamaıyorsunuzda.
Sizde tabii bu arad sağ gösterip soldan çakıyorsunuz.
Dosyanızı yolayın.ama bütün verileri ve gerçek verileri değil örnek yollayın çok sayfa varsa işlem yapılacak sayfalrı sadece yollaytımn yapayım.

 

[abbasonline]

Evren bey çok sağolun

Dosya ekte;

 

[Orion1]

Yandaki tabloda hücre birleştirmeleri var.Kimi başlıklar 6ncı satırda iken kimi değerler başlıklar 3ncü satırda.Karmaşıklık buradan laynaklanıyor.Birde tıkladığınız 2nci satırdaki değerleride ayni sayfaya koymayın.
Başka bir sayfaya koyup orada tıklayın.
Bu sayfa sizin veri tabanınız olsun.
Oraadan bütün işlemlerinizi ilgili verileri çekerek yapabilirsiniz.Tabiiki veritabanı mantığındada Hücre birleştirme gibi ıvır zıvır şeyler olmaz.Sütun başlokların olur ve ve verilerin olur.Zaten bu birleştirme olayı bütün işleri gebertiyor.Bu durmda yine yapılır.Başka yönetmide var ama en hızlı yönetemi şu an kulandığınız yönet.Diğerinde ise do loop while döngüsne girip yapılır.Ama her türlü döngü progarmı kasar.Bunuda unutmayın.İllaki bu şekilde bu sayfa olacak diyorsanız .dediğim 2nci döngülü şıkkı yaparım size.Ama veriler çoğalınca (10bin-40 bin) işlemler epey yavaşalar.Şu anda bu kadar veri ile bunu anlayamazsınmız.Ama veriler çoğlınca insanı bıktırı beklemek.:cool.

 

[abbasonline]

Evren bey, tıkladığınız 2nci satırdaki değerleride ayni sayfaya koymayın demişsiniz, diğer başka bir sayfaya koyunca kodları nasıl değiştirmemiz gerekir.

 

[Orion1]

sORGU DİYE BİR SAYFA OLUŞTURDUM.
Sayfa1 dede düzenleme yaptım.
Şimdi çalışıyor.
Dosyanız ektedir.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim alan As Byte, sh As Worksheet, sh2 As Worksheet
    If Intersect(Target, Range("A2:D2")) Is Nothing Then Exit Sub
    Set sh2 = Sheets("Sayfa1")
    Cancel = True
    If Target.Address = "$A$2" Then
        alan = 3
        Set sh = Sheets("RAPOR")
        ElseIf Target.Address = "$B$2" Then
        alan = 8
        Set sh = Sheets("RAPOR1")
        ElseIf Target.Address = "$D$2" Then
        alan = 5
        Set sh = Sheets("RAPOR3")
        ElseIf Target.Address = "$C$2" Then
        alan = 4
        Set sh = Sheets("RAPOR2")
    End If
    
    If Target <> "" Then
    sh.Columns("A:BV").ClearContents
    sh2.Range("A6").AutoFilter
    sh2.Range("A6").AutoFilter Field:=alan, Criteria1:="=*" & Target.Value & "*"
    sh2.Range("A6").CurrentRegion.Copy sh.Range("A6")
    sh2.Range("A6").AutoFilter
    sh.Select
    sh.Cells.EntireColumn.AutoFit
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
    End If
    Set sh = Nothing
End Sub

 

[abbasonline]

Evren bey, çok teşekkür ederim sağolun, birleştirilmiş hücreler olduğu zaman sizinde söylediğiniz gibi hata veriyor, muhtemelen çizelgedeki birleştirilmiş hücreleri bir şekilde tek hücreye yazmağa gayret edeceğim çok sağolun, kusurumuza bakmayın.