Dizi olayı ile kod aşağıda abey.

Private Sub ComboBox1_Change()



    Const Ekleme As String = "|ÞABLON|Sayfa1|liste|"

    Dim syf As Worksheet

    Dim arr, say As Integer

    

    ReDim arr(1 To Worksheets.Count)

    For Each syf In Worksheets

        If InStr(1, Ekleme, "|" & syf.Name & "|", 1) = 0 Then

            If LCase(syf.Name) Like LCase(Me.ComboBox1.Value) & "*" Then

                say = say + 1

                ReDim Preserve arr(1 To say)

                arr(say) = syf.Name

            End If

        End If

    Next

    Me.ListBox1.Clear

    If say > 0 Then Me.ListBox1.List = arr

    If Me.ComboBox1.Value = Empty Then Me.ListBox1.Clear

    

    Set syf = Nothing

    Erase arr



End Sub

---

@berduş hocam yinede yazayım C sürücüsüne Yedek adında yaedekleme yapılıyor excelin kapanma olayına yazmışlar aklınızda olsun.

amacım sadece listbox'a recordsetten veri almak olduğu için diğer kodları sildim, excele TmpSilme adlı yeni bir sayfa ekledim

Option Compare Text

Const Ekleme As String = "|ŞABLON|Sayfa1|liste|TmpSilme|"

Dim Sql As String

Dim Cn As Object

Dim Rs As Object



Private Sub UserForm_Initialize()

Dim syf, TmpVr As Worksheet, k As Byte



Set TmpVr = Sheets("TmpSilme")

    TmpVr.Unprotect "4455"

    TmpVr.Cells.Clear

  Hcr = 1

  

    For Each syf In Worksheets

        If InStr(1, Ekleme, "|" & syf.Name & "|", 1) = 0 Then

        TmpVr.Range("a" & Hcr) = syf.Name

        Hcr = Hcr + 1

        End If

    Next syf



Set Cn = CreateObject("Adodb.Connection")

Cn.ConnectionString = "provider=Microsoft.ACE.OLEDB.12.0;data source=" & _

                      ThisWorkbook.FullName & ";extended properties=""excel 8.0;hdr=no"""

Cn.Open



SQL = "select * from [TmpSilme$A:A] where [F1]<>'' order by [F1]"

Set Rs = CreateObject("adodb.recordset")

Rs.Open SQL, Cn, 3, 1

'

'  Eğer Hiç Kayıt Yoksa

If Rs.RecordCount = 0 Then

    Rs.Close

    Set Rs = Nothing

    MsgBox "Kayıt Bulunamadı.", vbCritical, "Veri Yok"

    Exit Sub

End If

 

ComboBox1.Column = Rs.GetRows



'With Me.ListBox1

'        .ColumnCount = Rs.Fields.Count

'        .Column = Rs.GetRows

''        .ColumnHeads = True

'End With

Rs.Close

Set Rs = Nothing



End Sub

---

dizi kullanmayı da denedim, diziye değeri recordsetten alıp listeye eklemeyi arr ile yaptım olmadı.

Çok teşekkürler Hocalarım ellerinize sağlık.

Hocalarım mesaj 27  deki kodu uygulayabildim. 28 mesajdaki kodlarda uygulanması gerekiyorsa eklediğim dosyaya uygularmısınız. Kalması gereken kodları silmeden.

Kodu alttaki gib yaptım çalıştı.

ComboBox1.Column = Rs.GetRows

olunca çalışmıyor onada bakacağım.

Private Sub UserForm_Initialize()

Dim syf, TmpVr As Worksheet, k As Byte



Set TmpVr = Sheets("TmpSilme")

    TmpVr.Unprotect "4455"

    TmpVr.Cells.Clear

  Hcr = 1

  

    For Each syf In Worksheets

        If InStr(1, Ekleme, "|" & syf.Name & "|", 1) = 0 Then

        TmpVr.Range("a" & Hcr) = syf.Name

        Hcr = Hcr + 1

        End If

    Next syf



Set Cn = CreateObject("Adodb.Connection")

Set Rs = CreateObject("adodb.recordset")



Cn.Open "provider=Microsoft.ACE.OLEDB.12.0;data source=" & _

                      ThisWorkbook.FullName & ";extended properties=""excel 8.0;hdr=no"""



SQL = "select * from [TmpSilme$A:A] where not isnull(f1) order by [F1]"



Rs.Open SQL, Cn, 1, 1 '

'  Eðer Hiç Kayýt Yoksa

If Rs.RecordCount = 0 Then

    Rs.Close

    Set Rs = Nothing

    MsgBox "Kayýt Bulunamadý.", vbCritical, "Veri Yok"

    Exit Sub

End If



'ComboBox1.Column = Rs.GetRows



With Me.ListBox1



    .ColumnCount = Rs.Fields.Count

    .Column = Rs.GetRows



'        .ColumnHeads = True



End With

Rs.Close

Set Rs = Nothing



End Sub

Bende de tam tersi oluyor)

Buda çalışan hali.Önce recordset ile listboxa alındı recordset kapatılp tekrar açıldı ve comboya alındı veriler.

Private Sub UserForm_Initialize()

Dim syf, TmpVr As Worksheet, k As Byte



Set TmpVr = Sheets("TmpSilme")

    TmpVr.Unprotect "4455"

    TmpVr.Cells.Clear

  Hcr = 1

  

    For Each syf In Worksheets

        If InStr(1, Ekleme, "|" & syf.Name & "|", 1) = 0 Then

        TmpVr.Range("a" & Hcr) = syf.Name

        Hcr = Hcr + 1

        End If

    Next syf



Set Cn = CreateObject("Adodb.Connection")

Set Rs = CreateObject("adodb.recordset")



Cn.Open "provider=Microsoft.ACE.OLEDB.12.0;data source=" & _

                      ThisWorkbook.FullName & ";extended properties=""excel 8.0;hdr=no"""



SQL = "select * from [TmpSilme$A:A] where not isnull(f1) order by [F1]"



Rs.Open SQL, Cn, 1, 1 '

'  Eðer Hiç Kayýt Yoksa

If Rs.RecordCount = 0 Then

    Rs.Close

    Set Rs = Nothing

    MsgBox "Kayýt Bulunamadý.", vbCritical, "Veri Yok"

    Exit Sub

End If



'ComboBox1.Column = Rs.GetRows



With Me.ListBox1

    .ColumnCount = Rs.Fields.Count

    .Column = Rs.GetRows



'        .ColumnHeads = True

End With



Rs.Close

Rs.Open SQL, Cn, 1, 1

ComboBox1.Column = Rs.GetRows



Rs.Close

Cn.Close

Set Rs = Nothing

Set Cn = Nothing



End Sub

---

Böylede oluyor önemli olan recordset kapatmak combo başta yada sonda olması şart değil.

Private Sub UserForm_Initialize()

Dim syf, TmpVr As Worksheet, k As Byte



Set TmpVr = Sheets("TmpSilme")

    TmpVr.Unprotect "4455"

    TmpVr.Cells.Clear

  Hcr = 1

  

    For Each syf In Worksheets

        If InStr(1, Ekleme, "|" & syf.Name & "|", 1) = 0 Then

        TmpVr.Range("a" & Hcr) = syf.Name

        Hcr = Hcr + 1

        End If

    Next syf



Set Cn = CreateObject("Adodb.Connection")

Set Rs = CreateObject("adodb.recordset")



Cn.Open "provider=Microsoft.ACE.OLEDB.12.0;data source=" & _

                      ThisWorkbook.FullName & ";extended properties=""excel 8.0;hdr=no"""



SQL = "select * from [TmpSilme$A:A] where not isnull(f1) order by [F1]"



Rs.Open SQL, Cn, 1, 1 '

'  Eğer Hiç Kayıt Yoksa

If Rs.RecordCount = 0 Then

    Rs.Close

    Set Rs = Nothing

    MsgBox "Kayıt Bulunamadı.", vbCritical, "Veri Yok"

    Exit Sub

End If



ComboBox1.Column = Rs.GetRows



Rs.Close

Rs.Open SQL, Cn, 1, 1

With Me.ListBox1

    .ColumnCount = Rs.Fields.Count

    .Column = Rs.GetRows



'        .ColumnHeads = True

End With



Rs.Close

Cn.Close

Set Rs = Nothing

Set Cn = Nothing



End Sub