makro kitaptan kitaba veri aktarma

[hakin]

arkadaşlar dosya ektedir ilginize teşekkürelr

 

[Orion1]

Dosyanız ekte.Yalnız ilk satır alan adı olarak kullanılmalı.Verileriniz 2nci satırdan itibaren girin.
Not:referanslardan microsoft activex dataobject 2.x library 'yi seçmeniz gerekiyor.

Sub kitap_aktar()
Dim conn As ADODB.Connection
Dim rs As ADODB.Recordset
Set conn = New ADODB.Connection
conn.Open "Provider=Microsoft.jet.oledb.4.0;data source=" & ThisWorkbook.Path & "\Kitap1.xls;" & "extended properties=""excel 8.0;Hdr=yes"""
Set rs = New ADODB.Recordset
Set rs = conn.Execute("Select top 20 ALAN1 from [Sayfa1$]")
Sheets("Sayfa1").Select
Range("A1:A20").Clear
Range("A2").CopyFromRecordset rs
rs.Close
conn.Close
Set rs = Nothing
Set conn = Nothing
MsgBox "Kitap aktarıldı"
End Sub

 

[Orion1]

Alternatif.Buda excel4 makro ile .

Sub kitap_aktar()
Dim i As Byte, yol As String, dosya As String
'Excel4 makro ile
Sheets("Sayfa1").Select
Range("A2:A65536").ClearContents
yol = "'" & ThisWorkbook.Path
dosya = "\[Kitap1.xls]"
For i = 2 To 21
    Cells(i, "A").Value = Application.ExecuteExcel4Macro(yol & dosya & "Sayfa1'!R" & i & "C1")
Next i
MsgBox "Kitap1 Akatrıldı."
End Sub