Debug hatasında ekrana uyarı mesajı gelsin

[ASLAN7410]

Merhaba herkese hayırlı bayramlar.

Bazen aşağıdaki kod'un koyu renkli yerde hata veriyor, bu hata oluştuğunda Tarihleri kontrol edin şeklinde uyarı mesajı eklemek istiyorum.

On Error Goto hata diye bir denetim buldum ama kodların arasına uygulayamadım.

Yardımcı olur musunuz?

Sub Getir()
Application.ScreenUpdating = False
Dim s1 As Worksheet, s2 As Worksheet
Set s1 = Sheets("İSTATİSTİK")
Set s2 = Sheets(s1.Range("C2").Value)
Tarih1 = CDate(s1.Range("C3"))
Tarih2 = CDate(s1.Range("C4"))
Dim son As Long
s1.Range("A7:F65536").ClearContents
son = s2.Range("B" & Rows.Count).End(3).Row
s2.Range("$B$1:$K$" & son).AutoFilter
s2.Range("$B$1:$K$" & son).AutoFilter Field:=1, Criteria1:= _
        ">=" & CLng(Tarih1), Operator:=xlAnd, Criteria2:="<=" & CLng(Tarih2)

[B]s2.Range("B2:F" & son).SpecialCells(xlCellTypeVisible).Copy Destination:=s1.Range("B7")[/B]
s2.Range("$B$1:$K$" & son).AutoFilter
For i = 7 To s1.Range("B" & Rows.Count).End(3).Row
    s1.Cells(i, 1) = i - 6
Next i
    Cells.WrapText = False
    
    Range("A7:F65536").Borders.LineStyle = xlNone
    Range("A1:F" & [A65536].End(3).Row).Borders.LineStyle = xlContinuous

    Range("B7").Select
Application.ScreenUpdating = True
MsgBox "İşlem tamam...", vbInformation, "ASLAN"
End Sub

 

[turist]

son = s2.Range("B" & Rows.Count).End(3).Row

satırından sonra

[B][COLOR="Blue"]On Error GoTo hata[/COLOR][/B]

ekleyin.

End Sub

satırından önce de;

[B][COLOR="blue"]hata: MsgBox "Tarihleri kontrol edin.", vbInformation, "ASLAN"[/COLOR][/B]

ekleyin ve deneyin.

 

[ASLAN7410]

Sayın turist, hayırlı akşamlar.

2 gündür forum kapalı olduğu için cevap yazamadım.

Sizin dediğiniz gibi yaptım, gayet güzel çalışıyor.
Kod hata vermeden yoluna devam ettiğinde de aşağıdaki iki tane mesaj peş peşe çıkıyor.

MsgBox "İşlem tamam...", vbInformation, "ASLAN"
hata: MsgBox "Tarihleri kontrol edin.", vbInformation, "ASLAN"

 

[Korhan Ayhan]

Deneyiniz.

Sub Getir()
    On Error GoTo Hata
    Application.ScreenUpdating = False
    Dim s1 As Worksheet, s2 As Worksheet
    Set s1 = Sheets("İSTATİSTİK")
    Set s2 = Sheets(s1.Range("C2").Value)
    Tarih1 = CDate(s1.Range("C3"))
    Tarih2 = CDate(s1.Range("C4"))
    Dim son As Long
    s1.Range("A7:F65536").ClearContents
    son = s2.Range("B" & Rows.Count).End(3).Row
    s2.Range("$B$1:$K$" & son).AutoFilter
    s2.Range("$B$1:$K$" & son).AutoFilter Field:=1, Criteria1:= _
            ">=" & CLng(Tarih1), Operator:=xlAnd, Criteria2:="<=" & CLng(Tarih2)
    
    s2.Range("B2:F" & son).SpecialCells(xlCellTypeVisible).Copy Destination:=s1.Range("B7")
    s2.Range("$B$1:$K$" & son).AutoFilter
    For i = 7 To s1.Range("B" & Rows.Count).End(3).Row
        s1.Cells(i, 1) = i - 6
    Next i
    Cells.WrapText = False
    
    Range("A7:F65536").Borders.LineStyle = xlNone
    Range("A1:F" & [A65536].End(3).Row).Borders.LineStyle = xlContinuous

    Range("B7").Select
    
    Application.ScreenUpdating = True
    MsgBox "İşlem tamam...", vbInformation, "ASLAN"
    Exit Sub
Hata:
    Application.ScreenUpdating = True
    MsgBox "Tarihleri kontrol edin.", vbInformation, "ASLAN"
End Sub

 

[ASLAN7410]

Sayın Korhan Bey hayırlı geceler, kodlar süper çalışıyor, ellerinize sağlık, çok teşekkür ediyorum.