Makroyu tüm listeye uygulama

[Reason01]

Aşağıda belirteceğim makroda sadece D sutunundaki 7. satırdaki liste çalışıyor.
listem 27. satıra kadar devam ediyor.
bunu tüm listemi kapsayacak şekilde modifiye edebilir miyiz ?


Private Sub Worksheet_Change(ByVal Target As Range)
Dim haftaSon As Integer, xx As Range
On Error GoTo hata
If Intersect(Target, Range("D7:AH" & Rows.Count)) Is Nothing Then Exit Sub

For Each xx In Range(Cells(Target.Row, "D"), Cells(Target.Row, "AH"))
haftaSon = WorksheetFunction.Weekday(xx.Offset(-1, 0), 2)
If xx.Value = "Rapor" And (haftaSon = 6 Or haftaSon = 7) Then
xx.Value = Replace(xx.Value, "Rapor", "Rpr")
End If
If xx.Value = "S" And (haftaSon = 6) Then
xx.Value = Replace(xx.Value, "S", "SS")
End If
If xx.Value = "S" And (haftaSon = 7) Then
xx.Value = Replace(xx.Value, "S", "")
End If
Next
hata:
End Sub

 

[Reason01]

İndir DENEME GÖNDER Son

Dosyayı indir DENEME GÖNDER Son

dosya.co

dosyayı da ek olarak gönderiyorum düzenleme lazım olursa diye

 

[ÖmerFaruk]

Şu satırı haftaSon = WorksheetFunction.Weekday(xx.Offset(-1, 0), 2)
Değiştin haftaSon = WorksheetFunction.Weekday(Cells(6, xx.Column), 2)

 

[Reason01]

Teşekkürler elinize sağlık sorun halledildi