bulentkars
Altın Üye
- Katılım
- 5 Ağustos 2005
- Mesajlar
- 671
- Excel Vers. ve Dili
- 2003 TR
- Altın Üyelik Bitiş Tarihi
- 23-03-2027
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
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