Sayfadan Listboxa alınan verileri, Sayfadan başka sayfayada alma

[beza]

Merhaba,
Aşagıdaki kodlar ile aradığım verileri kayıt sayfasından listbox1 e alıyorum. Aynı zamanda bu verileri sonuç sayfasına da almak istiyorum. Mevcut kodlara bu şekilde bir ilave yapılabilirmi?
Private Sub CommandButton2_Click()

Dim syf(), j As Byte, i As Integer, s As Byte, c As Range, S1 As Worksheet, Adr As String

syf = Array("Kayit")
Bul = ComboBox1

For j = 0 To UBound(syf)
Set S1 = Sheets(syf(j))
Set c = S1.[J:J].Find(Bul, , xlValues, xlWhole)
If Not c Is Nothing Then
Adr = c.Address
Do
SiparisNo = S1.Cells(c.Row, "B")
TTutar = S1.Cells(c.Row, "I")
STarih = S1.Cells(c.Row, "J")

With ListBox1
.AddItem
.List(.ListCount - 1, 0) = SiparisNo
.List(.ListCount - 1, 1) = STarih
.List(.ListCount - 1, 2) = TTutar
'.Selected(.ListCount - 1) = True
End With

Set c = S1.[J:J].FindNext(c)
Loop While Not c Is Nothing And c.Address <> Adr
s = 1
End If
If s = 1 Then Exit For
Next j

 

[cems]

Private Sub CommandButton2_Click()

    Dim syf(), j As Byte, i As Integer, s As Byte, c As Range, S1 As Worksheet
    Dim Adr As String, Bul As Variant
    Dim SiparisNo As Variant, TTutar As Variant, STarih As Variant
    Dim wsSonuc As Worksheet
    Dim sonucSatir As Long

    syf = Array("Kayit")
    Bul = ComboBox1.Value
    
    ' Sonuç sayfası
    Set wsSonuc = Sheets("Sonuc")
    sonucSatir = wsSonuc.Cells(wsSonuc.Rows.Count, 1).End(xlUp).Row + 1 ' Sonuç sayfasında ilk boş satırı bul
    
    For j = 0 To UBound(syf)
        Set S1 = Sheets(syf(j))
        Set c = S1.[J:J].Find(Bul, , xlValues, xlWhole)
        
        If Not c Is Nothing Then
            Adr = c.Address
            Do
                SiparisNo = S1.Cells(c.Row, "B").Value
                TTutar = S1.Cells(c.Row, "I").Value
                STarih = S1.Cells(c.Row, "J").Value
                
                ' ListBox1'e veri ekleme
                With ListBox1
                    .AddItem
                    .List(.ListCount - 1, 0) = SiparisNo
                    .List(.ListCount - 1, 1) = STarih
                    .List(.ListCount - 1, 2) = TTutar
                End With
                
                ' Sonuç sayfasına veri ekleme
                wsSonuc.Cells(sonucSatir, 1).Value = SiparisNo
                wsSonuc.Cells(sonucSatir, 2).Value = STarih
                wsSonuc.Cells(sonucSatir, 3).Value = TTutar
                sonucSatir = sonucSatir + 1 ' Bir sonraki satıra geç
                
                Set c = S1.[J:J].FindNext(c)
            Loop While Not c Is Nothing And c.Address <> Adr
            s = 1
        End If
        If s = 1 Then Exit For
    Next j

End Sub

Açıklamalar:

1. Sonuç Sayfası Tanımlaması: Set wsSonuc = Sheets("Sonuc") ile Sonuc sayfası tanımlanıyor. Burada Sonuc yerine kullanmak istediğiniz sayfa adını belirleyebilirsiniz.
2. Sonuç Sayfasında İlk Boş Satır: sonucSatir değişkeni, Sonuc sayfasında ilk boş satırı bulur ve verileri bu satıra ekler.
3. Veri Eklemek: ListBox1'e veri ekleme işlemi mevcut kodunuz gibi devam ederken, aynı zamanda Sonuc sayfasına da verileri ekler.

 

[beza]

Merhaba,
Eklediğiniz kodlar tam olarak istenileni verdi. Ayırdığınız zaman, paylaştığınız bilgi ve emeğiniz için
teşekkür ederim.

 

[cems]

Kolaylıklar dilerim ...