ListBox ta yardım

[ecvelance50]

mrb Ark.lar .
userfofm da oluşturulan listbox1 içerisine sayfa1! in C5hücresinden başlayarak dolu olan verileri almak ve listbox1 den coklu secim yaparak, sayfa2! nin B sutununun boş olan hücrerisine yazdırmak istiyorum ve bu işlemi yaparkende şu işlemi yapsın istiyorum ÖRNEK: Sayfa1=c10 deki veriyi listbox1den sectim diyelim (butona tıkladıgıma )
Sayfa2 nin boş olan B sutununa yazarken Safya1 in L10 sutunundaki veriyide Sayfa2 nin D sutununa aynı satıra yazsın istiyorum.

Konuları inceledim ama nasıl aratma yapacagım konusunda yarım kaldım. yardım ederseniz sevinirim

 

[askm]

Örnek dosya eklerseniz konu hakkında yardımcı olabiliriz.

 

[ecvelance50]

Örnek dosya eklerseniz konu hakkında yardımcı olabiliriz.

Hata indir

Hata

www.dosyaupload.com

 

[askm]

Aşağıdaki kodları deneyin.

Private Sub CommandButton1_Click()
    Dim i      As Long
    Dim sonsat As Long
    Dim son As Long
    son = Sheets("Sayfa1").Range("C" & Rows.Count).End(3).Row
    'Bakim.Range("A2:M65536").ClearContents ' Sayfa1 Temizlemek için
    For i = 0 To ListBox1.ListCount - 1
         sonsat = Range("c" & Rows.Count).End(xlUp).Row + 1
        If ListBox1.Selected(i) = True Then
            With Sheets("Sayfa2")
                .Cells(sonsat, "c") = ListBox1.List(i, 0)
                .Cells(sonsat, "K") = Format(Date, "dd.mm.yyyy")
                .Cells(sonsat, "M") = TextBox1.Text
                For k = 2 To son
                    If ListBox1.List(i, 0) = Sheets("Sayfa1").Cells(k, 3) Then
                        .Cells(sonsat, "L") = Sheets("Sayfa1").Cells(k, "L") / 140
                    End If
                Next k
                
            End With
        End If
    Next i
    MsgBox " Kayıt Yapıldı"
End Sub

 

[ecvelance50]

Aşağıdaki kodları deneyin.

Private Sub CommandButton1_Click()
    Dim i      As Long
    Dim sonsat As Long
    Dim son As Long
    son = Sheets("Sayfa1").Range("C" & Rows.Count).End(3).Row
    'Bakim.Range("A2:M65536").ClearContents ' Sayfa1 Temizlemek için
    For i = 0 To ListBox1.ListCount - 1
         sonsat = Range("c" & Rows.Count).End(xlUp).Row + 1
        If ListBox1.Selected(i) = True Then
            With Sheets("Sayfa2")
                .Cells(sonsat, "c") = ListBox1.List(i, 0)
                .Cells(sonsat, "K") = Format(Date, "dd.mm.yyyy")
                .Cells(sonsat, "M") = TextBox1.Text
                For k = 2 To son
                    If ListBox1.List(i, 0) = Sheets("Sayfa1").Cells(k, 3) Then
                        .Cells(sonsat, "L") = Sheets("Sayfa1").Cells(k, "L") / 140
                    End If
                Next k
               
            End With
        End If
    Next i
    MsgBox " Kayıt Yapıldı"
End Sub

Elinize emeginize saglık . çok işime yaradı teşekkürler. başarılar