İyi Günler;
2019 adli Klasörün içğinde, Bodro ve EFT adlı iki adet çalışma kitabı bulunmaktadır.
Bodro adlı kitapta her aya ait bodro bulunmakta olup EFT adlı kitapta ise Liste bulunmaktadır.
Yapmak istediğim ise;
EFT listesine, Bodro kitabından ait olduğu aya ait (EFT sayfasında B2'de Yıl, B3 Ay ismi bulunmakta) B sutunundaki isimleri ve K sutunundaki ödenen net ücretleri aktarmak istiyorum.
Örnek klasör ekte olup yardımlarınız için şimdiden teşekkür ederim.
Sub Düğme1_Tıkla()
Dim Time1 As Double, Time2 As Double
Dim timeElapsed As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Time1 = Now
Set con = CreateObject("adodb.connection")
dosya = Range("B3").Value
dosyayolu = ThisWorkbook.Path & "\" & dosya & ".xls"
con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
dosyayolu & ";extended properties=""Excel 12.0;hdr=no"""
sayfa = Range("B4").Value
sorgu = "select * from [" & sayfa & "$B8:b35]"
Set kayit = CreateObject("adodb.recordset")
kayit.Open sorgu, con, 1, 1
If kayit.RecordCount > 0 Then
Range("b8").CopyFromRecordset kayit
Time2 = Now
timeElapsed = Format(Time2 - Time1, "hh:mm:ss") & " Saniye"
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "Aktarma İşlemi Tamamlandı" & Chr(13) & Chr(13) & " İşlem Süresi: " & timeElapsed, vbInformation, "VERİ AKTARMA"
End If
End Sub
2019 adli Klasörün içğinde, Bodro ve EFT adlı iki adet çalışma kitabı bulunmaktadır.
Bodro adlı kitapta her aya ait bodro bulunmakta olup EFT adlı kitapta ise Liste bulunmaktadır.
Yapmak istediğim ise;
EFT listesine, Bodro kitabından ait olduğu aya ait (EFT sayfasında B2'de Yıl, B3 Ay ismi bulunmakta) B sutunundaki isimleri ve K sutunundaki ödenen net ücretleri aktarmak istiyorum.
Örnek klasör ekte olup yardımlarınız için şimdiden teşekkür ederim.
Sub Düğme1_Tıkla()
Dim Time1 As Double, Time2 As Double
Dim timeElapsed As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Time1 = Now
Set con = CreateObject("adodb.connection")
dosya = Range("B3").Value
dosyayolu = ThisWorkbook.Path & "\" & dosya & ".xls"
con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
dosyayolu & ";extended properties=""Excel 12.0;hdr=no"""
sayfa = Range("B4").Value
sorgu = "select * from [" & sayfa & "$B8:b35]"
Set kayit = CreateObject("adodb.recordset")
kayit.Open sorgu, con, 1, 1
If kayit.RecordCount > 0 Then
Range("b8").CopyFromRecordset kayit
Time2 = Now
timeElapsed = Format(Time2 - Time1, "hh:mm:ss") & " Saniye"
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "Aktarma İşlemi Tamamlandı" & Chr(13) & Chr(13) & " İşlem Süresi: " & timeElapsed, vbInformation, "VERİ AKTARMA"
End If
End Sub
Ekli dosyalar
-
32.3 KB Görüntüleme: 16