Bir modüle alttaki kodu ekleyip çalıştırırsanız istediğiniz olur.
Birde diğer türlü yaparım.609.cu satır sabitse alttaki kod biraz değişebilir kriter eklememeye gerek kalmaz.

Sub Aktar()

    

    Dim i As Integer, j As Integer

    Dim arr, bul As Range, bul2 As Range

    Dim kriter As String

    Dim yilSatir As Integer



    kriter = "YILI GÝDERLERÝ"

    

    arr = Array("OCAK", "ÞUBAT", "MART", "NÝSAN", "MAYIS", "HAZÝRAN", "TEMMUZ", "AÐUSTOS", "EYLÜL", "EKÝM", "KASIM", "ARALIK")

    

    Range("A609:G687").ClearContents

    

    Set bul2 = Range("A:G").Find(kriter)

    yilSatir = bul2.Row

    

    For i = LBound(arr) To UBound(arr)

        Set bul = Range("C").Find(arr(i))

        If Not bul Is Nothing Then

            For j = bul.Row + 3 To Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

                If Cells(j, 1).Value = "" Then Exit For

            Next

            Range("B" & bul.Row + 3 & ":G" & j - 1).Copy Range("B" & yilSatir + 3)

            yilSatir = Cells(Rows.Count, 4).End(3).Row - 3

        End If

    Next

    yilSatir = Cells(Rows.Count, 2).End(3).Row

    Range("A609").Value = 1

    Range("A609:A" & yilSatir).DataSeries

    Application.CutCopyMode = False



    Set bul = Nothing

    Set bul2 = Nothing

    Erase arr

End Sub