Listboxa süzüleni başka bir sayfaya aktarmak?

[udentr2002]

Merhaba arkadaşlar burdaki değerli bir hocamın yapmış olduğu kodları kullanarak comboboxun change olayına yazdığım kodlar ile listboxa süzme yapıyorum.
Sizlerden ricam bu süzmeyi yaparken süzülen verileride Rapor sayfasınada kopyalaması bunun için yardımlarınızı rica edeceğim.

cobobox un change olayındaki kodlarım şöyle

Dim i As Long, a As Long, k As Byte, deg As Double

ListBox1.RowSource = ""
ReDim myarr(1 To 12, 1 To 1)
For i = 3 To Cells(65536, "B").End(xlUp).Row
    If LCase(Replace(Replace(Cells(i, "C").Value, "I", "ı"), "İ", "i")) Like LCase(ComboBox1.Value & "*") _
    And LCase(Replace(Replace(Cells(i, "E").Value, "I", "ı"), "İ", "i")) Like LCase(ComboBox2.Value & "*") _
    And LCase(Replace(Replace(Cells(i, "F").Value, "I", "ı"), "İ", "i")) Like LCase(ComboBox3.Value & "*") Then
    

        a = a + 1
        ReDim Preserve myarr(1 To 12, 1 To a)
        For k = 1 To 12
            myarr(k, a) = Cells(i, k).Value
          
        Next k
        
        If a = 1 Then
            deg = Cells(i, 10).Value
            ElseIf Cells(i, 10).Value < deg Then
            deg = Cells(i, 10).Value
        End If
    End If
Next i


If a > 0 Then ListBox1.Column = myarr
Erase myarr
Label4.Caption = Format(deg, "#,##0.00") & " " & "YTL'dir"

yukarıdaki kodlar "Veri" sayfasından istenilen veriyi süzüp listboxda gösteriyor.
bu kodlara eklemek istediğim veriyi listboxa süzdükten sonra süzülen verileri Rapor sayfasına 3. satırdan sonra yapıştırması bunun için nasıl bir kod eklemesi yapabiliriz. Yardımcı olursanız çok sevinirim.

 

[Orion1]

Kodu aşağıdaki gibi değişitirniz.

Sheets("Rapor").range("A3:L65536").clear
sheets("Rapor").select
If a > 0 Then 
     ListBox1.Column = myarr
     [A3].resize(a,12)=application.transpose(myarr)
end if

 

[udentr2002]

Evren Hocam tekrar tekrar ilgilendiğiniz için teşekkür ederim zaten sizde biliyorsunuzki kodlar size ait.
Benim sormak istediğim ise şu 1. mesajımdaki vermiş olduğum kodlar süzme işlemlerini yaparken başka işlemlerde yapmaktadır bu yüzden sizin gönderdiğiniz kodları hangi aralığa yazmalıyım yani ilk kodun işlevini bozmadan sadece süzmeyi yaptıktan sonra süzülenleri rapor syfasınada kopyalamalı.
tekrar bakarsanız çok makbule geçecektir hocam

 

[Orion1]

Aşağıdaki kırmızı satırlar.

Dim i As Long, a As Long, k As Byte, deg As Double

ListBox1.RowSource = ""
ReDim myarr(1 To 12, 1 To 1)
For i = 3 To Cells(65536, "B").End(xlUp).Row
    If LCase(Replace(Replace(Cells(i, "C").Value, "I", "ı"), "İ", "i")) Like LCase(ComboBox1.Value & "*") _
    And LCase(Replace(Replace(Cells(i, "E").Value, "I", "ı"), "İ", "i")) Like LCase(ComboBox2.Value & "*") _
    And LCase(Replace(Replace(Cells(i, "F").Value, "I", "ı"), "İ", "i")) Like LCase(ComboBox3.Value & "*") Then
    

        a = a + 1
        ReDim Preserve myarr(1 To 12, 1 To a)
        For k = 1 To 12
            myarr(k, a) = Cells(i, k).Value
          
        Next k
        
        If a = 1 Then
            deg = Cells(i, 10).Value
            ElseIf Cells(i, 10).Value < deg Then
            deg = Cells(i, 10).Value
        End If
    End If
Next i
[COLOR="Red"][B]Sheets("Rapor").range("A3:L65536").clear
sheets("Rapor").select
If a > 0 Then 
     ListBox1.Column = myarr
     [A3].resize(a,12)=application.transpose(myarr)
end if[/B][/COLOR]
Erase myarr
Label4.Caption = Format(deg, "#,##0.00") & " " & "YTL'dir"