kapalı olan dosyalardaki verileri kopyalama

[ilhan40]

MERHABA

benim C diskimdeki skf ve kkf adında iki dosyam var. Bu dosyalara devamlı veri ekliyorum.

D diskimde genel adında dosyam var bu dosyada sayfa 1 deki a düğmesine bastığımda

C diskindeki skf ve kkf dosyalardaki verileri

genel dosyadaki sayfalarına yapıştırmasını istiyorum.

 

[Orion1]

dosyaları xls (2003) formatında eklerseniz bakabilirim.

 

[ilhan40]

tekrar gönderiyorum ilgizi için teşekkür ederim

 

[Orion1]

Her 2 dosyanızında C:\ Kök dizininde olması lazım.
Genel_59 dosyasının nerede olduğu önemli değil..
Dosyanız ektedir.

Sub KKF_aktar()
Dim conn As ADODB.Connection, rs As ADODB.Recordset
Dim s1 As Worksheet
'Tools Refernce'den Microoft acitivex dataobject 2.8 library seçildi
Set s1 = Sheets("kalibrasyon_kayıt_formu")
Set conn = New ADODB.Connection
Set rs = New ADODB.Recordset
Application.ScreenUpdating = False
s1.Range("A2:M65536").ClearContents
conn.Open "Provider=microsoft.jet.oledb.4.0;data source=C:\KKF.xls;extended properties=""excel 8.0;hdr=yes"""
rs.Open "Select * from [kalibrasyon_kayıt_formu$];", conn, adOpenKeyset, adLockReadOnly
If rs.RecordCount > 0 Then s1.Range("A2").CopyFromRecordset rs
rs.Close
conn.Close
Set rs = Nothing: Set conn = Nothing: Set s1 = Nothing
Application.ScreenUpdating = True
MsgBox "KKF dosyasından veriler alındı." & vbLf & _
"evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N"
End Sub
Sub SKF_aktar()
Dim conn As ADODB.Connection, rs As ADODB.Recordset
Dim s1 As Worksheet
'Tools Refernce'den Microoft acitivex dataobject 2.8 library seçildi
Set s1 = Sheets("sertifika_uygunsuz_formu")
Set conn = New ADODB.Connection
Set rs = New ADODB.Recordset
Application.ScreenUpdating = False
s1.Range("A2:M65536").ClearContents
conn.Open "Provider=microsoft.jet.oledb.4.0;data source=C:\SKF.xls;extended properties=""excel 8.0;hdr=yes"""
rs.Open "Select * from [sertifika_uygunsuz_formu$];", conn, adOpenKeyset, adLockReadOnly
If rs.RecordCount > 0 Then s1.Range("A2").CopyFromRecordset rs
rs.Close
conn.Close
Set rs = Nothing: Set conn = Nothing: Set s1 = Nothing
Application.ScreenUpdating = True
MsgBox "SKF dosyasından veriler alındı." & vbLf & _
"evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N"
End Sub

 

[ilhan40]

evren gizlen hocam ilginiz ve yardımınız için teşekkür ederim. elinize ve emeğinize sağlık

 

[Orion1]

evren gizlen hocam ilginiz ve yardımınız için teşekkür ederim. elinize ve emeğinize sağlık

Rica ederim.
İyi çalışmalar.