Listbox' Tan Çoklu Veriyi Seçime Göre Tabloya Aktarma

Ben bir örnek hazırlayayım.

Dizi içine alıp listboxta seçilen  o diziye alınıp ve mevcut tabloya akatarayım tabii başarabilirsem.

iyi çalışmalar)

teşekkürler FERAZ örneğinizi merakla bekliyorum.

Rica edeim abey.
Basit bir dosya hazırladım öncekilerden bağımsız.

Option Compare Database



Private Sub Komut0_Click()





    Dim con As ADODB.Connection

    Dim rs As ADODB.Recordset

    Dim sSql As String

    Dim yol As String

    

    Set rs = New ADODB.Recordset

    Set con = New ADODB.Connection

    

    With Liste1

    .RowSourceType = "Tablo/Sorgu"

    End With

    

    sSql = "select * from [Sayfa1$A8:G] where F1 Is Not Null"



    

    yol = CurrentProject.Path & "\bilgiler.xls"

  

    con.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & yol & ";extended properties=""excel 12.0;hdr=no;imex=1"""

    

    rs.CursorLocation = adUseClient

    rs.CursorType = adOpenKeyset

    rs.LockType = adLockOptimistic



    

    rs.Open sSql, con

    Liste1.ColumnCount = rs.Fields.Count

  Set Me.Liste1.Recordset = rs





    rs.Close

    con.Close

    Set rs = Nothing



End Sub

Private Sub Komut5_Click()



Dim i As Long

Dim arr, say As Long





With Liste1

    ReDim arr(1 To 7, 1 To .ListCount)

    say = 0

    

    For i = 0 To .ListCount - 1

        If .Selected(i) = False Then

            say = say + 1

            arr(1, say) = .Column(0, i)

            arr(2, say) = .Column(1, i)

            arr(3, say) = .Column(2, i)

            arr(4, say) = .Column(3, i)

            arr(5, say) = .Column(4, i)

            arr(6, say) = .Column(5, i)

            arr(7, say) = .Column(6, i)

        

        End If

    Next

    .RowSourceType = "Değer Listesi"

    .RowSource = ""

    .ColumnCount = 7

    ReDim Preserve arr(1 To 7, 1 To say)



CurrentDb.Execute "DELETE * FROM Tablo1"

CurrentDb.TableDefs.Refresh



Set RST = CurrentDb.OpenRecordset("Tablo1", dbOpenTable)



For i = LBound(arr) To say

        RST.AddNew

        RST(0) = arr(1, i)

        RST(1) = arr(2, i)

        RST(2) = arr(3, i)

        RST(3) = arr(4, i)

        RST(4) = arr(5, i)

        RST(5) = arr(6, i)

        RST(6) = arr(7, i)

        RST.Update

    .AddItem (arr(1, i) & ";" & arr(2, i) & ";" & arr(3, i) & ";" & arr(4, i) & ";" & arr(5, i) & ";" & arr(6, i) & ";" & arr(7, i))



Next i



End With



CurrentDb.TableDefs.Refresh



Erase arr



End Sub

aktarım daha kolay olmuş..teşekkürler eline sağlık.

Rica ederi,kolay gelsin.