Bir sayfada datalarım var ve oradan istediklerimi başka bir sayfada özet tablo içerisinde özetlemesini istiyorum. Eğer girdiğim kriterler varsa sorun yok. Eğer kritere uygun veriler yoksa mevcut sayfada kalmasını istiyorum.
Aşağıdaki kodları yazdım.
Kriterler varsa sorun yok Yoksa mevsut sayfada durmasını sağlıyamadım.
Yardımcı olursanız sevinirim.
Sorgu2 sayfasında makroyu çalıştırdığımda aradığım data sayfasında varsa getirsin ve öaet tabloda aktarsın yoksa sorgu2 sayfasında kalsın istiyorum.
Sub Sorgu3()
'
' Makro9 Makro
'
'
Application.ScreenUpdating = False
On Error GoTo Hata
Sheets("Sorgu2").Select
Range("A100:L5000").Select
Selection.ClearContents
Sheets("Data").Select
Range("lst").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
"Kriter2"), CopyToRange:=Range("Sorgu2!A100"), Unique:=False
Sheets("Seçim").Select
Range("A3").Select
ActiveSheet.PivotTables("Özet Tablo 1").PivotCache.Refresh
Hata:
cevap = MsgBox("Alış Fiyatı Yok", vbOKOnly)
If cevap = 1 Then
Sheets("Sorgu2").Select
Exit Sub
Else
Sheets("Seçim").Select
Range("A3").Select
ActiveSheet.PivotTables("Özet Tablo 1").PivotCache.Refresh
End If
Application.ScreenUpdating = True
End Sub
Aşağıdaki kodları yazdım.
Kriterler varsa sorun yok Yoksa mevsut sayfada durmasını sağlıyamadım.
Yardımcı olursanız sevinirim.
Sorgu2 sayfasında makroyu çalıştırdığımda aradığım data sayfasında varsa getirsin ve öaet tabloda aktarsın yoksa sorgu2 sayfasında kalsın istiyorum.
Sub Sorgu3()
'
' Makro9 Makro
'
'
Application.ScreenUpdating = False
On Error GoTo Hata
Sheets("Sorgu2").Select
Range("A100:L5000").Select
Selection.ClearContents
Sheets("Data").Select
Range("lst").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
"Kriter2"), CopyToRange:=Range("Sorgu2!A100"), Unique:=False
Sheets("Seçim").Select
Range("A3").Select
ActiveSheet.PivotTables("Özet Tablo 1").PivotCache.Refresh
Hata:
cevap = MsgBox("Alış Fiyatı Yok", vbOKOnly)
If cevap = 1 Then
Sheets("Sorgu2").Select
Exit Sub
Else
Sheets("Seçim").Select
Range("A3").Select
ActiveSheet.PivotTables("Özet Tablo 1").PivotCache.Refresh
End If
Application.ScreenUpdating = True
End Sub
Ekli dosyalar
-
369 KB Görüntüleme: 4
