Veri satırları aşağıya doğru uzamaktadır.
Verileri  Kriter olarak Sonuç başlığında DEVAM EDEN satırları Liste sayfasına H başlığına göre 1.Grup, 2.Grup ve 3.Grup a göre sıralatmak istiyorum. Veri aralığı değişmektedir. Son veriyi baz alarak işlem yapılabilir mi?
Veri sayfasından verileri Veri süze göre alıp liste sayfasında sıralatabilirim ama macro ile işi kolay bir şekilde tıkladığım zaman aktarsın istiyorum. Liste sayfasından da farklı bir şablona göre otomatik yazdırma yapacağım. Yardımcı olan arkadaşlara teşekkür ederim.

Kod altta abey.

Sub Aktar()



Dim son As Long, i As Long, say As Long, k As Byte

Dim veri

Dim syfVeri As Worksheet

Dim syfListe As Worksheet



Set syfVeri = ThisWorkbook.Worksheets("Veri")

Set syfListe = ThisWorkbook.Worksheets("Liste")



With syfVeri

    son = .Range("A" & Rows.Count).End(3).Row + 1

    veri = .Range("A2:j" & son).Value

    

    ReDim arr(1 To son, 1 To UBound(veri, 2))

    

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

        If LCase(veri(i, 9)) = "devam eden" Then

          say = say + 1

            For k = 1 To UBound(veri, 2)

                arr(say, k) = veri(i, k)

            Next

        End If

    Next

End With



syfListe.Range("C2:L" & Rows.Count).ClearContents



If say > 0 Then

    syfListe.Range("C2").Resize(say, UBound(veri, 2)).Value = arr

    syfListe.Range("C2").Resize(say, UBound(veri, 2)).Sort syfListe.Range("j2"), xlAscending, , , , , , xlNo

End If



MsgBox "Bitti"

On Error Resume Next

Erase veri: Erase arr

Set syfVeri = Nothing

Set syfListe = Nothing

End Sub

Sayın feraz bey çok sağolun aktarma işlemi gayet başarılı. Acaba veri sayfasında J sütununu da Liste sayfasına veri aktarmaya dahil etsek kodda nereyi değiştirmeliyiz.

Bişey değil abey.
Resimdeki gibi J sütunu aktarıyor.


https://resim.accesstr.net/do.php?img=11177

Sayın feraz bey Veri sayfasındaki j sütununu Liste sayfasına aktarmak istiyorum.

https://dosya.co/8qn3snhq7e53/J_sütunu.jpg.html

Abey önceki kodda aktarıyordu.
Alttaki kodu deneyin birde.
burdaki 10 yazanı 11 yaparsanız K sütununa kadar olur örneğin.

Sub Aktar()



Dim son As Long, i As Long, say As Long, k As Byte

Dim veri

Dim syfVeri As Worksheet

Dim syfListe As Worksheet



Const sonSutun As Byte = 10 'J sütun



Set syfVeri = ThisWorkbook.Worksheets("Veri")

Set syfListe = ThisWorkbook.Worksheets("Liste")



With syfVeri

    son = .Range("A" & Rows.Count).End(3).Row + 1

    veri = .Range("A2", .Cells(son, sonSutun)).Value

    

    ReDim arr(1 To son, 1 To sonSutun)

    

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

        If LCase(veri(i, 9)) = "devam eden" Then

          say = say + 1

            For k = 1 To sonSutun

                arr(say, k) = veri(i, k)

            Next

        End If

    Next

End With



syfListe.Range("C2:L" & Rows.Count).ClearContents



If say > 0 Then

    syfListe.Range("C2").Resize(say, sonSutun).Value = arr

    syfListe.Range("C2").Resize(say, sonSutun).Sort syfListe.Cells(2, sonSutun), xlAscending, , , , , , xlNo

End If



MsgBox "Bitti"

On Error Resume Next

Erase veri: Erase arr

Set syfVeri = Nothing

Set syfListe = Nothing

End Sub