Soru makro kod sorunları

[kmlbyrk]

Kod:
Sub aktar()
Application.ScreenUpdating = False
Dim renk As Long, s1 As Worksheet, s2 As Worksheet
Dim son1 As Long, son2 As Long, i As Long, s As Long
Set s1 = Sayfa2: Set s2 = Sayfa16
son1 = s1.Cells(Rows.Count, 1).End(3).Row
son2 = s2.Cells(Rows.Count, 2).End(3).Row + s2.Cells(Rows.Count, 7).End(3).Row

s2.Range("A3:I" & son2 + 1).ClearContents

For s = 5 To s1.Cells(2, Columns.Count).End(1).Column
    For i = 4 To son1 Step 4
        If s1.Cells(i, s).Interior.ColorIndex = 43 Then
            son2 = s2.Cells(Rows.Count, 2).End(3).Row + 1
            s2.Cells(son2, 1) = son2 - 2
            s2.Cells(son2, 2) = s1.Cells(i, 2)
            s2.Cells(son2, 3) = s1.Cells(i, 3)
            s2.Cells(son2, 4) = CDate(s1.Cells(2, s))
        End If
        
        If s1.Cells(i, s).Interior.ColorIndex = 3 Then
            son2 = s2.Cells(Rows.Count, 7).End(3).Row + 1
            s2.Cells(son2, 6) = son2 - 2
            s2.Cells(son2, 7) = s1.Cells(i, 2)
            s2.Cells(son2, 8) = s1.Cells(i, 3)
            s2.Cells(son2, 9) = CDate(s1.Cells(2, s))
        End If

    Next i
Next
s2.Columns("A:I").EntireColumn.AutoFit
Set s1 = Nothing: Set s2 = Nothing
son1 = 0: son2 = 0: renk = 0
i = 0: s = 0
Application.ScreenUpdating = True
End Sub

Merhaba,

Yukarıda verdiğim kodlar çalışıyor. Ancak veri aldığı sayfada en üstten bir satır ekledim. Artık işlev görmemeye başladı. Satır ekleme yaptığımda kod içerisinde değişmem gereken bir şey var mıdır? Bana yardımcı olursanız müteşekkir kalırım

Şimdiden teşekkür eder,
Saygılarımı sunarım

 

[kmlbyrk]

Merhaba,

Sorunu çözdüm.

kodlarda "i" aşağı doğru satır sayısını gösterir. Dolayısı ile üstten bir satır eklemişseniz. "For i = 4 To son1 Step 4" satırındaki "i=4" kodunu "i=5" yaptığımızda normale döner ve kodlar çalışır.

İyi çalışmalar dilerim