Soru Filtreye Uygun Veri yoksa uyarı versin..

[bulentkars]

Arkadaşlar Merhaba,

Aşağıdaki kod ile Filtre işlemini kullanarak verileri başka sayfaya kopyalıyorum. ancak, filre aralığına veri uymadığından tüm verileri kopyalama yapıyor, ben kodda 2 adet filtreleme yapmışım eğer filtre boş çıkıyorsa bana veri bulunamadı mesajını vermesini istiyorum. Yardımcı olabilirseniz sevinirim. Şİmdiden Teşekkürler



Sub Mukerer_Kayıtlar()

Application.ScreenUpdating = False

Application.DisplayAlerts = False




Sheets("Mükerrer Kayıtlar").[A2:J1000007].ClearContents
Sheets("TÜM-ŞUBELER").Select
Range("A1").Select

'--------------------------------------------------------------------------------------------------

' AŞAĞIDAKİ 2 KRİTERDE VERİ YOKSA VERİ YOK UYARISI VERMESİNİ İSTİYORUM.

Selection.AutoFilter
ActiveSheet.Range("$A$1:$J$1000007").AutoFilter Field:=3, Criteria1:= _
xlFilterToday, Operator:=xlFilterDynamic



ActiveSheet.Range("$A$1:$J$1000007").AutoFilter Field:=8, Criteria1:=RGB(255, _
199, 206), Operator:=xlFilterCellColor


'------------------------------------------------------------------------------------------------------

say = WorksheetFunction.CountA(Range("A:A"))


Range("A2:J" & say).Select
Selection.Copy
Sheets("Mükerrer Kayıtlar").Select
Range("A2").Select
ActiveSheet.Paste
Range("A1").Select



Columns("A:J").EntireColumn.AutoFit

MsgBox "İşlem Tamam", vbInformation, Application.UserName

Application.ScreenUpdating = True

Application.DisplayAlerts = True

End Sub