userform listbox ta seçili olan satırı sayfaya aktarma

[netvolxxx]

merhaba şöyle bir çalışmam var data sayfasında verilerim var userform açıldığında textbox ara yaptırıp listbox a listeleniyor burda seçili olan buton ile aktar dediğimde cari sayfasına aktarmasını yapamadım bi türlü nasıl olcak.
yardımlarınızı bekliyorum....

listbox gelen satırdaki tüm bilgiyi satırı aktarcak cari sayfasına.

örnek dosyayı ekledim ekte....

Private Sub CommandButton1_Click()
Set s1 = Sayfa1
Son = s1.Cells(Rows.Count, "B").End(3).Row

If TextBox1.Value = "" Then
ListBox1.Clear
Exit Sub
End If

For i = 1 To Son
If LCase(s1.Cells(i, 2)) Like "*" & LCase(TextBox1.Value) & "*" Then
ListBox1.AddItem s1.Cells(i, 2)
End If
Next i
End Sub



Private Sub CommandButton2_Click()
Application.ScreenUpdating = False
On Error Resume Next
Set s1 = ThisWorkbook.Worksheets("data")
Set s2 = ThisWorkbook.Worksheets("cari")
s2.Range("a2:n2").ClearContents
For i = 2 To s1.Range("B65536").End(xlUp).Row
If s1.Cells(i, "B") = s2.Cells(1, "N") Then
sonsatir = s2.Range("a65536").End(xlUp).Row + 1
For k = 1 To 14
s2.Cells(sonsatir, N) = s1.Cells(i, O)
Next k
End If
Next i
Application.ScreenUpdating = True
MsgBox "İşlem TAMAM.", vbInformation
End Sub

 

[pitchoute]

Yedek aldıktan sonra şöyle deneyip sonucu paylaşabilir misiniz;

Option Explicit

Private Sub CommandButton1_Click()
    Dim s1 As Worksheet
    Dim Son As Long    
    Dim i As Long      
    Dim listIndex As Long
    Dim j As Integer  
    Const ILK_SATIR As Long = 2
    Const ARAMA_SUTUNU As Long = 2
    Const TOPLAM_SUTUN As Integer = 14

    On Error GoTo HataYonetimi

    Set s1 = ThisWorkbook.Worksheets("data")

    ListBox1.Clear
    If Trim(TextBox1.Value) = "" Then
        MsgBox "Lütfen aranacak bir değer girin.", vbInformation
        TextBox1.SetFocus
        Exit Sub
    End If

    Son = s1.Cells(s1.Rows.Count, ARAMA_SUTUNU).End(xlUp).Row
    If Son < ILK_SATIR Then
        MsgBox "'data' sayfasında aranacak veri bulunamadı.", vbInformation
        Exit Sub
    End If

    ListBox1.ColumnCount = TOPLAM_SUTUN
    ListBox1.ColumnWidths = "50;150;80;80;80;80;80;80;80;80;80;80;80;80"

    Application.ScreenUpdating = False

    For i = ILK_SATIR To Son
        If InStr(1, LCase(s1.Cells(i, ARAMA_SUTUNU).Value), LCase(Trim(TextBox1.Value)), vbTextCompare) > 0 Then
            ListBox1.AddItem s1.Cells(i, 1).Value
            listIndex = ListBox1.ListCount - 1
            For j = 1 To TOPLAM_SUTUN - 1
                ListBox1.List(listIndex, j) = s1.Cells(i, j + 1).Value
            Next j
        End If
    Next i

    Application.ScreenUpdating = True

    If ListBox1.ListCount = 0 Then
        MsgBox "Arama kriterine uygun kayıt bulunamadı.", vbInformation
    End If

    Exit Sub

HataYonetimi:
    Application.ScreenUpdating = True 
    MsgBox "Arama sırasında bir hata oluştu: " & vbCrLf & Err.Description, vbCritical
End Sub

Private Sub CommandButton2_Click()
    Dim s2 As Worksheet
    Dim sonsatir As Long
    Dim selectedIndex As Long
    Dim k As Integer    
    Const TOPLAM_SUTUN As Integer = 14

    On Error GoTo HataYonetimi

    Set s2 = ThisWorkbook.Worksheets("cari")

    If ListBox1.ListIndex = -1 Then
        MsgBox "Lütfen 'cari' sayfasına aktarmak için listeden bir satır seçin.", vbExclamation, "Seçim Yapılmadı"
        Exit Sub
    End If

    selectedIndex = ListBox1.ListIndex

    sonsatir = s2.Cells(s2.Rows.Count, "A").End(xlUp).Row + 1

    Application.ScreenUpdating = False

    For k = 0 To TOPLAM_SUTUN - 1
        s2.Cells(sonsatir, k + 1).Value = ListBox1.List(selectedIndex, k)
    Next k

    Application.ScreenUpdating = True

    MsgBox "Seçili satır '" & s2.Name & "' sayfasının " & sonsatir & ". satırına başarıyla aktarıldı.", vbInformation, "İşlem Tamam"
    Exit Sub 

HataYonetimi:
    Application.ScreenUpdating = True
    MsgBox "Aktarma sırasında bir hata oluştu: " & vbCrLf & Err.Description, vbCritical
End Sub

Private Sub UserForm_Initialize()

    Const TOPLAM_SUTUN As Integer = 14
    ListBox1.ColumnCount = TOPLAM_SUTUN
    ListBox1.ColumnWidths = "50;150;80;80;80;80;80;80;80;80;80;80;80;80"
End Sub