Aktarma kodu düzenlemesi

[ASLAN7410]

Merhaba arkadaşlar herkese hayırlı akşamlar.

Aşağıdaki kodu Sayın Ömer BARAN Bey hazırlamıştı, bu koda mesaj eklemek istiyorum.

Yani sayfada H sütununda bugünün tarihi ve bugün tarihinden büyük tarihler varsa, Aktaracak birşey bulunamadı. şeklinde mesaj gelmesini,
H sütununda bugünün tarihinden küçük tarih varsa aşağıdaki kod çalışıp Günü geçenler arşive aktarıldı. şeklinde mesaj gelmesini istiyorum.

Kendim yapmaya çalıştım ancak başaramadım.
Yardımcı olacak arkadaşlara şimdiden teşekkür ederim.

Sub ArşiveAktar()
Application.ScreenUpdating = False

For satır = [H65536].End(3).Row To 2 Step -1
    If Cells(satır, 8) = "" Or Cells(satır, 8) >= Date Then GoTo 10
    sat = Sheets("ARŞİV").[H65536].End(3).Row + 1
    Range("A" & satır & ":J" & satır).Copy Sheets("ARŞİV").Range("A" & sat & ":J" & sat)
    Sheets("ARŞİV").Range("A" & sat & ":J" & sat).FormatConditions.Delete
    Sheets("ARŞİV").Range("A1:J" & Sheets("ARŞİV").[H65536].End(3).Row).Borders.LineStyle = xlContinuous
    Range("A" & satır & ":J" & satır).Delete Shift:=xlUp
10: Next
End Sub

 

[Mustafa MUTLU]

Sub ArşiveAktar()
Application.ScreenUpdating = False
MM = 0
For satır = [H65536].End(3).Row To 2 Step -1
    If Cells(satır, 8) = "" Or Cells(satır, 8) >= Date Then GoTo 10
    sat = Sheets("ARŞİV").[H65536].End(3).Row + 1
    Range("A" & satır & ":J" & satır).Copy Sheets("ARŞİV").Range("A" & sat & ":J" & sat)
    Sheets("ARŞİV").Range("A" & sat & ":J" & sat).FormatConditions.Delete
    Sheets("ARŞİV").Range("A1:J" & Sheets("ARŞİV").[H65536].End(3).Row).Borders.LineStyle = xlContinuous
    Range("A" & satır & ":J" & satır).Delete Shift:=xlUp
    MM = MM + 1
10: Next
If MM > 0 Then
MsgBox MM & " Adet Günü geçenler arşive aktarıldı."
Else
MsgBox "Aktaracak birşey bulunamadı."
End If
End Sub

 

[ASLAN7410]

Sayın Mustafa Bey ilginiz için çok teşekkür ediyorum.

Düzenlemiş olduğunuz kodu çalıştırdığım zaman, önce Aktarılacak birşey bulunamadı diyor, sonra aktarma yapıyor Günü geçenler aktarıldı mesajı gelmiyor.

Yani istediğim gibi çalışmadı.

 

[ASLAN7410]

Sayın Mustafa Bey kodlar arasında MM = MM + 1 bu kısmı görmemişim, kusura bakmayın, tam istediğim gibi çalışıyor.

Ellerinize sağlık, hayırlı çalışmalar.

 

[Mustafa MUTLU]

Sayın Mustafa Bey kodlar arasında MM = MM + 1 bu kısmı görmemişim, kusura bakmayın, tam istediğim gibi çalışıyor.

Ellerinize sağlık, hayırlı çalışmalar.

İşinizi görüyorsa ne mutlu..