- Katılım
- 13 Mayıs 2005
- Mesajlar
- 761
- Excel Vers. ve Dili
- 2010 Türkçe
- Altın Üyelik Bitiş Tarihi
- 03.11.2024
İki ayrı makro ile yaparım tek makroyla olurmu? Biraz uğraşayım hocam
DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Set Kayit_Seti = Baglanti.Execute("Select * From [Şubat1$C2:J] Where F3 Is Not Null")
Option Explicit
Sub MuhSgk_Aktar3_GSS()
Dim Dosya As String, Baglanti As Object, Sorgu As String
Dim Kayit_Seti As Object, Sayfa As Worksheet, Zaman As Double
Dosya = Application.GetOpenFilename(FileFilter:="Excel Dosyaları (*.xls;*.xlsx;*.xlsm),*xls;*.xlsm;*.xlsx", MultiSelect:=False)
Zaman = Timer
Set Baglanti = CreateObject("AdoDb.Connection")
Baglanti.Open "Provider=Microsoft.Ace.OleDb.12.0;Data Source=" & _
Dosya & ";Extended Properties=""Excel 12.0;Hdr=No"""
Sorgu = "Select F1 From [maasEBildirgeExcel$B2:B]"
Set Kayit_Seti = Baglanti.Execute(Sorgu)
Cells(Rows.Count, 2).End(3)(2, 1).CopyFromRecordset Kayit_Seti
Sorgu = "Select F1, F2, F3, F4, F5, F6, F7, F8, F9, F10, F11, F12, F13, F14, F15, F16, F17, F18, F19, F20, F21, F22 From [maasEBildirgeExcel$D2:Y]"
Set Kayit_Seti = Baglanti.Execute(Sorgu)
Cells(Rows.Count, 4).End(3)(2, 1).CopyFromRecordset Kayit_Seti
Kayit_Seti.Close
Baglanti.Close
Set Kayit_Seti = Nothing
Set Baglanti = Nothing
MsgBox "Veri aktarımı tamamlanmıştır." & Chr(10) & Chr(10) & _
"İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
End Sub
emeginize saglik linki yenileme sansiniz var mi?.
Buradaki dosya işinize yarayabilir.
.