[ÇÖZÜLDÜ] Veri aktarırken I sütunundaki ibareye göre aktarsın.

[kelkitli]

[ÇÖZÜLDÜ] Veri aktarırken I sütunundaki ibareye göre aktarsın.

Değerli Dostlar Selamlar,
Bir sayfadan diğerine aşağıdaki kodlarla veri aktarıyorum. Ancak istiyorum ki "I" sütununda "ÖDENDİ" yazılı olanları aktarsın. (Kırmızı renkli bölüm)

Sub Ayın_6_Yuzde_5_Ceza()
Application.ScreenUpdating = False
Dim Odeme, Oran, Ceza, Borc, Toplam As Double
Dim Say, IslemNo, SraNo As Long
Dim SonSatir, HatAdi As String
Dim S1, S2, S3 As Worksheet
Dim Bak, Ara As Range
Set S1 = Sheets("tahakkukedenborç")
Set S2 = Sheets("cezalı")

Say = S1.Cells(65536, "A").End(3).Row

For Each Bak In S1.Range("A2:A" & Say)
'Hatadi
Odeme = S1.Range(Bak.Offset(0, 8).Address).Value
If Odeme = Empty Then

SonSatir = S2.Cells(65536, "A").End(3).Row
SraNo = Val(S2.Cells(SonSatir, "A").Value)
If SraNo = 0 Then
SraNo = Val("1")
Else
SraNo = Val(S2.Cells(SonSatir, "A").Value) + 1
End If
S2.Cells(SonSatir + 1, "a").Value = SraNo

If S1.Range(Bak.Offset(0, 8).Address) = "ÖDENDİ" Then
S1.Range(Bak.Offset(0, 1), Bak.Offset(0, 7).Address).Copy
S2.Cells(SonSatir + 1, "b").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

Borc = S1.Range(Bak.Offset(0, 7).Address).Value
Oran = S2.Cells(2, "K").Value
Ceza = Borc * Oran
Toplam = (Borc + Ceza)
S2.Cells(SonSatir + 1, "H").Value = Round(Toplam, 2)
S2.Cells(SonSatir + 1, "J").Value = Date

End If
Next Bak
Set S1 = Nothing
Set S2 = Nothing
End Sub

Kırmızı renkli kısmı silince tüm veriyi aktarıyor. Ekleyince de hata oluşuyor. Nasıl yapılmalı?

 

[kelkitli]

Değerli Dostlar özür işlemin sonucunu test ederken hata yapmışım.

Odeme = S1.Range(Bak.Offset(0, 8).Address).Value
If Odeme = Empty Then