Bence en ideal gifte gösterdiğim gibi.Bir buton ekledim ona tıklayınca aktif satırlar ilgili yere numaralanarak aktarılır.

Ofis versiyonunuz heralde 2003 uzantı değiştirdim emin değilim 2003 için olduğuna.

Private Sub cmdEkle_Click()



    Dim i As Integer

    Const satir As Integer = 609

    

    With Sayfa1

        .Select

        .Range("A" & satir).Value = 1

        For i = satir To .Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

            If .Cells(i, 2).Value = "" Then Exit For

        Next

        .Range("B" & ActiveCell.Row & ":G" & ActiveCell.Row).Copy .Range("B" & i)

        If i = satir Then GoTo son

        .Range("A" & i).Value = .Range("A" & i - 1).Value + 1

    End With

son:

    Application.CutCopyMode = False

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    With cmdEkle

        If Target.Row >= 4 And Target.Column <= 7 Then

            .Visible = True

            .Top = Target.Top

        Else

            .Visible = False

        End If

        If Target.Row > 605 Then .Visible = False

    End With

End Sub