Sonu değişen satırı kopyalama

[StarsScream]

Elimde böyle bir kod var yalnız "433" sürekli değişiyor C sütunu sonunda boşluk var ama A sütunu sonunda yok yani boşluğa kadar alamıyorum. Yardımcı olursanız sevinirim.
Şimdiden teşekkürler

Sub Kopyala()

    Dim s1  As Worksheet, _
        s2  As Worksheet, _
        Kol As Integer
    
    Set s1 = Sheets("Sayfa1")
    Set s2 = Sheets("Sayfa2")
    
    On Error Resume Next
    
    Kol1 = s2.Range(Cells(2, 1), Cells(2, Columns.Count)).Find("*", , , , xlByColumns, xlPrevious).Column
    Kol1 = Kol1 + 1
    
    Kol2 = s2.Range(Cells(2, 1), Cells(2, Columns.Count)).Find("*", , , , xlByColumns, xlPrevious).Column
    Kol2 = Kol2 + 2
    
    
    s1.Range("A17:A433").Copy s2.Cells(2, Kol1)
    s1.Range("C17:C433").Copy s2.Cells(2, Kol2)
    
End Sub

 

[Korhan Ayhan]

Deneyiniz.

....
....
....
    son = S1.Cells(Rows.Count, 1).End(3).Row
    s1.Range("A17:A" & son).Copy s2.Cells(2, Kol1)
    s1.Range("C17:C" & son).Copy s2.Cells(2, Kol2)