Aynı sayfada birden çok sayfa açma

[koboy]

Merhaba
ansayfa diye bir sayfam var burda
bölümlere ayırdım
kasa
banka diye

kasanın altına bağlı alt adları filan yazdım
a kasası
b kasarı
bunlara tıklayınca kasa sayfasına gidiyor
ançak banka diye bölüm ekledim ama bunu makronun içine nasıl ekleyecem





Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim sh As Worksheet
If Intersect(Target, Range("A6:B" & Cells(Rows.Count, "A").End(xlUp).Row)) Is Nothing Then Exit Sub
If Target.Value = "" Then Exit Sub
Set sh = Sheets("kasa")
sh.Range("E1").AutoFilter
sh.Range("A2").AutoFilter field:=2, Criteria1:=Cells(Target.Row, "A").Value
sh.Select

--- bu kısımı ekledim çalışmadı üsteki kısım çalışıyor
If Intersect(Target, Range("F6:B" & Cells(Rows.Count, "A").End(xlUp).Row)) Is Nothing Then Exit Sub
If Target.Value = "" Then Exit Sub
Set sh = Sheets("kasa2")
sh.Range("E1").AutoFilter
sh.Range("A2").AutoFilter field:=2, Criteria1:=Cells(Target.Row, "A").Value
sh.Select


End Sub

 

[askm]

Örnek olmadan anca bu şekilde olur sanırım.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim sh As Worksheet
If Intersect(Target, Range("A6:B" & Cells(Rows.Count, "A").End(xlUp).Row)) Is Nothing 
If Target.Value = "" Then Exit Sub
Set sh = Sheets("kasa")
sh.Range("E1").AutoFilter
sh.Range("A2").AutoFilter field:=2, Criteria1:=Cells(Target.Row, "A").Value
sh.Select
end if
'--- bu kısımı ekledim çalışmadı üsteki kısım çalışıyor
If Intersect(Target, Range("F6:B" & Cells(Rows.Count, "A").End(xlUp).Row)) Is Nothing Then Exit Sub
If Target.Value = "" Then Exit Sub
Set sh = Sheets("kasa2")
sh.Range("E1").AutoFilter
sh.Range("A2").AutoFilter field:=2, Criteria1:=Cells(Target.Row, "A").Value
sh.Select
End Sub

 

[koboy]

Syntax eror hatası verdi dosya ekleyim mi

Örnek olmadan anca bu şekilde olur sanırım.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim sh As Worksheet
If Intersect(Target, Range("A6:B" & Cells(Rows.Count, "A").End(xlUp).Row)) Is Nothing 
If Target.Value = "" Then Exit Sub
Set sh = Sheets("kasa")
sh.Range("E1").AutoFilter
sh.Range("A2").AutoFilter field:=2, Criteria1:=Cells(Target.Row, "A").Value
sh.Select
end if
'--- bu kısımı ekledim çalışmadı üsteki kısım çalışıyor
If Intersect(Target, Range("F6:B" & Cells(Rows.Count, "A").End(xlUp).Row)) Is Nothing Then Exit Sub
If Target.Value = "" Then Exit Sub
Set sh = Sheets("kasa2")
sh.Range("E1").AutoFilter
sh.Range("A2").AutoFilter field:=2, Criteria1:=Cells(Target.Row, "A").Value
sh.Select
End Sub

 

[koboy]

bu şekilde sorunu çözdüm b sutünündakini getiriyorum başka sorunum var a sutunu 20 satırına
tablo ekliyorum onu sayfa yönlendirmesinide (kasa)sayfasına yapıyor

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim sh As Worksheet
If Intersect(Target, Range("A6:A20:F6" & Cells(Rows.Count, "A").End(xlUp).Row)) Is Nothing Then Exit Sub
Set sh = Sheets("kasa")
sh.Range("E1").AutoFilter
sh.Range("A2").AutoFilter field:=2, Criteria1:=Cells(Target.Row, "A").Value
sh.Select

'--- bu kısımı ekledim çalışmadı üsteki kısım çalışıyor
If Intersect(Target, Range("F6:K" & Cells(Rows.Count, "A").End(xlUp).Row)) Is Nothing Then Exit Sub
If Target.Value = "" Then Exit Sub
Set sh = Sheets("kasa2")
sh.Range("E1").AutoFilter
sh.Range("A2").AutoFilter field:=2, Criteria1:=Cells(Target.Row, "A").Value
sh.Select


If Intersect(Target, Range("A25:K" & Cells(Rows.Count, "A").End(xlUp).Row)) Is Nothing Then Exit Sub
If Target.Value = "" Then Exit Sub
Set sh = Sheets("kasa4")
sh.Range("E1").AutoFilter
sh.Range("A2").AutoFilter field:=2, Criteria1:=Cells(Target.Row, "A").Value
sh.Select


End Sub

 

[koboy]

yok mu yardımcı olacak bi abimiz çok lazım

 

[koboy]

örnek dosya ekledim yardım bekliyorum