Yıllar bazında cari listeleme

[igultekin2000]

iyi günler ; çalışma sayfalarındaki yıllara yaygın firma carileri LISTE sayfasında tek parça olarak getiriyorum. her yılı gösteren renkli açıklayıcı satır çıkıyor. ancak hesapta işlem olmadığında, yani sadece devir rakamlı tek satır olduğunda açıklayıcı yıl satırı çıkmıyor. Satır tek olarak geliyor. bu durumda da yılı gösteren renkli satırı getirmeyi başaramadım. kullandığım makro

Sub aktarr()
Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual

On Error Resume Next
Sheets("LISTE").Range("a3:ı65536").ClearContents
Sheets("LISTE").Range("a3:ı65536").Interior.ColorIndex = xlNone

Set s1 = ThisWorkbook.Worksheets("LISTE")

Set s2 = ThisWorkbook.Worksheets("2014")
sonsatir = s1.Range("c65536").End(xlUp).Row + 1
sonn = s2.Range("ı65536").End(xlUp).Row
If WorksheetFunction.CountIf(s2.Range("ı2:ı" & sonn), s1.Cells(2, "c")) >= 2 Then
For k = 1 To 9
s1.Cells(sonsatir, k) = s2.Cells(2, k)
s1.Cells(sonsatir, k).Interior.ColorIndex = s2.Cells(2, k).Interior.ColorIndex
Next k
End If
For i = 2 To s2.Range("ı65536").End(xlUp).Row
If s2.Cells(i, "ı") = s1.Cells(2, "c") Then
sonsatir = s1.Range("c65536").End(xlUp).Row + 1
For k = 1 To 9
s1.Cells(sonsatir, k) = s2.Cells(i, k)
Next k
End If
Next i


Set s2 = ThisWorkbook.Worksheets("2015")
sonsatir = s1.Range("c65536").End(xlUp).Row + 1
sonn = s2.Range("ı65536").End(xlUp).Row
If WorksheetFunction.CountIf(s2.Range("ı2:ı" & sonn), s1.Cells(2, "c")) >= 2 Then
For k = 1 To 9
s1.Cells(sonsatir, k) = s2.Cells(2, k)
s1.Cells(sonsatir, k).Interior.ColorIndex = s2.Cells(2, k).Interior.ColorIndex
Next k
End If
For i = 2 To s2.Range("ı65536").End(xlUp).Row
If s2.Cells(i, "ı") = s1.Cells(2, "c") Then
sonsatir = s1.Range("c65536").End(xlUp).Row + 1
For k = 1 To 9
s1.Cells(sonsatir, k) = s2.Cells(i, k)
Next k
End If
Next i
    
Set s2 = ThisWorkbook.Worksheets("2016")
sonsatir = s1.Range("c65536").End(xlUp).Row + 1
sonn = s2.Range("ı65536").End(xlUp).Row
If WorksheetFunction.CountIf(s2.Range("ı2:ı" & sonn), s1.Cells(2, "c")) >= 2 Then
For k = 1 To 9
s1.Cells(sonsatir, k) = s2.Cells(2, k)
s1.Cells(sonsatir, k).Interior.ColorIndex = s2.Cells(2, k).Interior.ColorIndex
Next k
End If
For i = 2 To s2.Range("ı65536").End(xlUp).Row
If s2.Cells(i, "ı") = s1.Cells(2, "c") Then
sonsatir = s1.Range("c65536").End(xlUp).Row + 1
For k = 1 To 9
s1.Cells(sonsatir, k) = s2.Cells(i, k)
Next k
End If
Next i

Set s2 = ThisWorkbook.Worksheets("2017")
sonsatir = s1.Range("c65536").End(xlUp).Row + 1
sonn = s2.Range("ı65536").End(xlUp).Row
If WorksheetFunction.CountIf(s2.Range("ı2:ı" & sonn), s1.Cells(2, "c")) >= 2 Then
For k = 1 To 9
s1.Cells(sonsatir, k) = s2.Cells(2, k)
s1.Cells(sonsatir, k).Interior.ColorIndex = s2.Cells(2, k).Interior.ColorIndex
Next k
End If
For i = 2 To s2.Range("ı65536").End(xlUp).Row
If s2.Cells(i, "ı") = s1.Cells(2, "c") Then
sonsatir = s1.Range("c65536").End(xlUp).Row + 1
For k = 1 To 9
s1.Cells(sonsatir, k) = s2.Cells(i, k)
Next k
End If
Next i
Set s2 = ThisWorkbook.Worksheets("2018")
sonsatir = s1.Range("c65536").End(xlUp).Row + 1
sonn = s2.Range("ı65536").End(xlUp).Row
If WorksheetFunction.CountIf(s2.Range("ı2:ı" & sonn), s1.Cells(2, "c")) >= 2 Then
For k = 1 To 9
s1.Cells(sonsatir, k) = s2.Cells(2, k)
s1.Cells(sonsatir, k).Interior.ColorIndex = s2.Cells(2, k).Interior.ColorIndex
Next k
End If
For i = 2 To s2.Range("ı65536").End(xlUp).Row
If s2.Cells(i, "ı") = s1.Cells(2, "c") Then
sonsatir = s1.Range("c65536").End(xlUp).Row + 1
For k = 1 To 9
s1.Cells(sonsatir, k) = s2.Cells(i, k)
Next k
End If
Next i
Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic

End Sub