ListBoxta seçilen verileri Sütunlara aktar

[omeryılmaz]

Merhaba Ardadaşlar.

ListBoxta süzülüp seçilen personelin ad ve siçilini alt alta dosya sırtlığında ilk sütuna aktardım amnac diğer yan sütuna aktaramadım.


Private Sub CommandButton9_Click()
Dim X, i, s As Long
Dim satir, say, say2 As Integer

If ListBox1.ListCount < 1 Then
MsgBox "Listede hiç veri yok", vbInformation, "Bilgilendirme!"
Exit Sub
End If
If ListBox1.ListIndex < 0 Then
MsgBox "Lütfen listeden veri seçimi yapınız.", vbExclamation, "Dikkat !"
Exit Sub
End If

Dim col As New Collection
With ListBox1
For i = .ListCount - 1 To 0 Step -1
If .Selected(i) Then
say = say + 1
col.Add i + 2
End If
Next i
If say = 0 Then
MsgBox " Seçili veri bulunamadı "
Else
If MsgBox(say & " adet satırı aktarmak istiyormusunuz?", vbYesNo) = vbYes Then


If say > 75 Then
MsgBox ("En fazla 75 adet Veri aktarılabilir")

For i = 0 To ListBox1.ListCount - 1
ListBox1.Selected(i) = True
Next i
Exit Sub
End If


say2 = 0
Sheets("SIRTLIK").Range("D332").ClearContents
Sheets("SIRTLIK").Range("J3:J32").ClearContents
Sheets("SIRTLIK").Range("P332").ClearContents
Sheets("SIRTLIK").Range("V3:V32").ClearContents
Sheets("SIRTLIK").Range("AB3:AB32").ClearContents
Sheets("SIRTLIK").Range("C2") = Evaluate("=UPPER(""" & ComboBox1.Text & """)")
i = Sheets("SIRTLIK").Cells(Rows.Count, "d").End(3).Row + 1
For X = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(X) = True Then
If i < 3 Then i = 3
Sheets("SIRTLIK").Cells(i, 4) = ListBox1.List(X, 1)
Sheets("SIRTLIK").Cells(i + 1, 4) = ListBox1.List(X, 2)
i = i + 1
Sheets("SIRTLIK").Cells(i + 1, 4) = ListBox1.List(X, 1)
Sheets("SIRTLIK").Cells(i + 1, 4) = ListBox1.List(X, 2)
i = i + 1
End If
say2 = say2 + 1
Next X

'If say > 15 Then
'i = i + 15
'End If
say = 0
s = Sheets("SIRTLIK").Range("d65536").End(3).Row
Sheets("SIRTLIK").Range("d" & s) = ""

Sheets("SIRTLIK").Select
MsgBox " İşlem Tamamdır..."

End If
End If
End With
Set col = Nothing
ListBox1.Clear

End Sub

Dosya ektedir

Yardım ve önerileriniz için şimdiden şükranlarımı sunuyorum

 

[suleyman242]

Private Sub CommandButton9_Click()
altındaki koda karşılık gelen kısmı bu şekilde değiştir,
ben denedim çalıştı.

        Sheets("SIRTLIK").Range("D3:D32").ClearContents
        Sheets("SIRTLIK").Range("J3:J32").ClearContents
        Sheets("SIRTLIK").Range("P3:P32").ClearContents
        Sheets("SIRTLIK").Range("V3:V32").ClearContents
        Sheets("SIRTLIK").Range("AB3:AB32").ClearContents
        Sheets("SIRTLIK").Range("C2") = Evaluate("=UPPER(""" & ComboBox1.Text & """)")
        Cells(3, 4).Select
        i = Sheets("SIRTLIK").Cells(Rows.Count, "d").End(3).Row + 1
                    y = 4   ' y yi 4 olarak tanımladım
                    For X = 0 To ListBox1.ListCount - 1         ' listboxta kaç tane veri var
                        If ListBox1.Selected(X) = True Then
                        If i < 3 Then i = 3
                        Sheets("SIRTLIK").Cells(i, y) = ListBox1.List(X, 1)
                        Sheets("SIRTLIK").Cells(i + 1, y) = ListBox1.List(X, 2)
                        i = i + 1
                        i = i + 1
                    If i >= 32 And i < 64 Then
                    y = y + 6
                    i = 3
                    End If
                    If i >= 64 And i < 96 Then
                    y = y + 6
                    i = 3
                    End If
                    End If
                    Next X

 

[omeryılmaz]

Private Sub CommandButton9_Click()
altındaki koda karşılık gelen kısmı bu şekilde değiştir,
ben denedim çalıştı.

        Sheets("SIRTLIK").Range("D3:D32").ClearContents
        Sheets("SIRTLIK").Range("J3:J32").ClearContents
        Sheets("SIRTLIK").Range("P3:P32").ClearContents
        Sheets("SIRTLIK").Range("V3:V32").ClearContents
        Sheets("SIRTLIK").Range("AB3:AB32").ClearContents
        Sheets("SIRTLIK").Range("C2") = Evaluate("=UPPER(""" & ComboBox1.Text & """)")
        Cells(3, 4).Select
        i = Sheets("SIRTLIK").Cells(Rows.Count, "d").End(3).Row + 1
                    y = 4   ' y yi 4 olarak tanımladım
                    For X = 0 To ListBox1.ListCount - 1         ' listboxta kaç tane veri var
                        If ListBox1.Selected(X) = True Then
                        If i < 3 Then i = 3
                        Sheets("SIRTLIK").Cells(i, y) = ListBox1.List(X, 1)
                        Sheets("SIRTLIK").Cells(i + 1, y) = ListBox1.List(X, 2)
                        i = i + 1
                        i = i + 1
                    If i >= 32 And i < 64 Then
                    y = y + 6
                    i = 3
                    End If
                    If i >= 64 And i < 96 Then
                    y = y + 6
                    i = 3
                    End If
                    End If
                    Next X

Eline sağlık teşekkürler kardeşim.

 

[suleyman242]

Eline sağlık teşekkürler kardeşim.

Bende teşekkür ederim kolay gelsin.