Yardım COMBOBOX ARAMA MAKROSU

azraep' Alıntı:

Kodlarınızda ufak bi düzeltme ile listeleme sorumu çözüldü gibi

Kod:Panoya kopyala

Private Sub UserForm_Initialize()
Dim x, a, b, z, k As Long, c As Variant

'Unique Records
Sheets("Kayıtlar").Activate
For x = 2 To Cells(Rows.Count, 1).End(xlUp).Row
If WorksheetFunction.CountIf(Range("B2:B" & x), Cells(x, 2)) = 1 Then
ComboBox1.AddItem Cells(x, 2).Value
End If
Next
'Alphabetic Order
For a = 0 To ComboBox1.ListCount - 1
  For b = a To ComboBox1.ListCount - 1
        If ComboBox1.List(b) < ComboBox1.List(a) Then
c = ComboBox1.List(a)
    ComboBox1.List(a) = ComboBox1.List(b)
    ComboBox1.List(b) = c
       End If
  Next
  Next

End Sub

combobox seçim kodunda da aşağıdaki değişiklik işinizi görecektir

Kod:Panoya kopyala

Private Sub ComboBox1_Change()
say = Cells(Rows.Count, 1).End(xlUp).Row

Genişletmek için tıkla ...

azraep' Alıntı:

A1:G1 kayıtlardaki başlıkları aldım.
Sayfaya ekle kodunuzu da değiştirdim.
Umarım işinizi görür.

Kod:Panoya kopyala

Private Sub CommandButton1_Click()

Dim s1 As Worksheet

    Set s1 = Sheets("Sayfa5")
    s1.Range("A2:G2").ClearContents
    If ListBox1.ListCount = 0 Then
     MsgBox "There Is No Data To Be Copied.", vbCritical, ""
     Exit Sub
    End If
   
    sat = 1
    For i = 0 To ListBox1.ListCount - 1
        If ListBox1.Selected(i) = True Then
            For x = 0 To 6
                s1.Cells(2, sat).Value = ListBox1.Column(x, i)
                sat = sat + 1
            Next
        End If
    Next

    MsgBox "The Selected Data Was Copied.", vbApplicationModal, ""
    Set s1 = Nothing
    Unload Me

Genişletmek için tıkla ...