Excelden başka bir excele veri aktarmak

eda arık · 29 Haziran 2020

Merhaba, "siparişi gelmiş ürün" isimli excel dosyasına "aktarılacak datalar" isimli excel dosyasındaki verileri aktarmak istiyorum. Bunu 'siparişi gelmiş ürün' excelindeki 'Sayfa1' deki 'verileri aktar' butonuna tıklayıp aktarmak istiyorum. Aktarılacak verilerin sayfa isimleri şunlardır: Sayfa1-->Sayfa1'e, Sayfa2-->Sayfa2'ye, sipariş listesi --> sipariş listesi'ne aktarılacak. Yardımlarınız için şimdiden teşekkürler.

cemshan · 29 Haziran 2020

Bu konuda yardım almak için örnek dosya eklemenizi öneririm.

eda arık · 29 Haziran 2020

Örnek dosya ekledim aslında gözükmüyor mu? tırnak içinde yazdığım "siparişi gelmiş ürün" ve "aktarılacak datalar" dan dosyalara ulaşabilirsiniz.

Korhan Ayhan · 29 Haziran 2020

Deneyiniz.

C++:

Option Explicit

Sub Verileri_Aktar()
    Dim Dosya As Variant, S1 As Worksheet, S2 As Worksheet, S3 As Worksheet
    Dim Baglanti As Object, Sorgu As String, Kayit_Seti As Object, Zaman As Double
   
    Dosya = Application.GetOpenFilename(FileFilter:="Excel Çalışma Kitapları (*.xl*),*.xl*", _
            Title:="Lütfen Dosya Seçiniz...", MultiSelect:=False)

    Zaman = Timer
   
    If Dosya <> False Then
        Set Baglanti = CreateObject("AdoDb.Connection")
        Set S1 = Sheets("Sayfa1")
        Set S2 = Sheets("Sayfa2")
        Set S3 = Sheets("sipariş listesi")
       
        S1.Range("A2:G" & S1.Rows.Count).ClearContents
        S2.Range("A2:E" & S2.Rows.Count).ClearContents
        S3.Range("A2:G" & S3.Rows.Count).ClearContents
   
        If Dosya <> ThisWorkbook.FullName Then
            Baglanti.Open "Provider=Microsoft.Ace.OleDb.12.0;Data Source=" & _
            Dosya & ";Extended Properties=""Excel 12.0;Hdr=Yes"""
                       
            Sorgu = "Select * From [" & S1.Name & "$]"
            Set Kayit_Seti = Baglanti.Execute(Sorgu)
            S1.Range("A2").CopyFromRecordset Kayit_Seti
            S1.Columns.AutoFit
           
            Sorgu = "Select * From [" & S2.Name & "$]"
            Set Kayit_Seti = Baglanti.Execute(Sorgu)
            S2.Range("A2").CopyFromRecordset Kayit_Seti
            S2.Columns.AutoFit
           
            Sorgu = "Select * From [" & S3.Name & "$]"
            Set Kayit_Seti = Baglanti.Execute(Sorgu)
            S3.Range("A2").CopyFromRecordset Kayit_Seti
            S3.Columns.AutoFit
           
            If Kayit_Seti.State <> 0 Then Kayit_Seti.Close
            If Baglanti.State <> 0 Then Baglanti.Close
        End If
   
        Set Kayit_Seti = Nothing
        Set Baglanti = Nothing
        Set S1 = Nothing
        Set S2 = Nothing
        Set S3 = Nothing
           
        MsgBox "Veri aktarımı tamamlanmıştır." & Chr(10) & Chr(10) & _
               "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
    Else
        MsgBox "Dosya seçimi yapmadığınız için işleminiz iptal edilmiştir.", vbCritical
    End If
End Sub

eda arık · 29 Haziran 2020

Korhan Ayhan' Alıntı:

Deneyiniz.

C++:

Option Explicit

Sub Verileri_Aktar()
    Dim Dosya As Variant, S1 As Worksheet, S2 As Worksheet, S3 As Worksheet
    Dim Baglanti As Object, Sorgu As String, Kayit_Seti As Object, Zaman As Double
  
    Dosya = Application.GetOpenFilename(FileFilter:="Excel Çalışma Kitapları (*.xl*),*.xl*", _
            Title:="Lütfen Dosya Seçiniz...", MultiSelect:=False)

    Zaman = Timer
  
    If Dosya <> False Then
        Set Baglanti = CreateObject("AdoDb.Connection")
        Set S1 = Sheets("Sayfa1")
        Set S2 = Sheets("Sayfa2")
        Set S3 = Sheets("sipariş listesi")
      
        S1.Range("A2:G" & S1.Rows.Count).ClearContents
        S2.Range("A2:E" & S2.Rows.Count).ClearContents
        S3.Range("A2:G" & S3.Rows.Count).ClearContents
  
        If Dosya <> ThisWorkbook.FullName Then
            Baglanti.Open "Provider=Microsoft.Ace.OleDb.12.0;Data Source=" & _
            Dosya & ";Extended Properties=""Excel 12.0;Hdr=Yes"""
                      
            Sorgu = "Select * From [" & S1.Name & "$]"
            Set Kayit_Seti = Baglanti.Execute(Sorgu)
            S1.Range("A2").CopyFromRecordset Kayit_Seti
            S1.Columns.AutoFit
          
            Sorgu = "Select * From [" & S2.Name & "$]"
            Set Kayit_Seti = Baglanti.Execute(Sorgu)
            S2.Range("A2").CopyFromRecordset Kayit_Seti
            S2.Columns.AutoFit
          
            Sorgu = "Select * From [" & S3.Name & "$]"
            Set Kayit_Seti = Baglanti.Execute(Sorgu)
            S3.Range("A2").CopyFromRecordset Kayit_Seti
            S3.Columns.AutoFit
          
            If Kayit_Seti.State <> 0 Then Kayit_Seti.Close
            If Baglanti.State <> 0 Then Baglanti.Close
        End If
  
        Set Kayit_Seti = Nothing
        Set Baglanti = Nothing
        Set S1 = Nothing
        Set S2 = Nothing
        Set S3 = Nothing
          
        MsgBox "Veri aktarımı tamamlanmıştır." & Chr(10) & Chr(10) & _
               "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
    Else
        MsgBox "Dosya seçimi yapmadığınız için işleminiz iptal edilmiştir.", vbCritical
    End If
End Sub

Sorunsuz çalıştı çok teşekkür ederim yardımınız için emeğinize sağlık.

kinikemrah · 16 Kasım 2020

Korhan Ayhan' Alıntı:

Deneyiniz.

C++:

Option Explicit

Sub Verileri_Aktar()
    Dim Dosya As Variant, S1 As Worksheet, S2 As Worksheet, S3 As Worksheet
    Dim Baglanti As Object, Sorgu As String, Kayit_Seti As Object, Zaman As Double
   
    Dosya = Application.GetOpenFilename(FileFilter:="Excel Çalışma Kitapları (*.xl*),*.xl*", _
            Title:="Lütfen Dosya Seçiniz...", MultiSelect:=False)

    Zaman = Timer
   
    If Dosya <> False Then
        Set Baglanti = CreateObject("AdoDb.Connection")
        Set S1 = Sheets("Sayfa1")
        Set S2 = Sheets("Sayfa2")
        Set S3 = Sheets("sipariş listesi")
       
        S1.Range("A2:G" & S1.Rows.Count).ClearContents
        S2.Range("A2:E" & S2.Rows.Count).ClearContents
        S3.Range("A2:G" & S3.Rows.Count).ClearContents
   
        If Dosya <> ThisWorkbook.FullName Then
            Baglanti.Open "Provider=Microsoft.Ace.OleDb.12.0;Data Source=" & _
            Dosya & ";Extended Properties=""Excel 12.0;Hdr=Yes"""
                       
            Sorgu = "Select * From [" & S1.Name & "$]"
            Set Kayit_Seti = Baglanti.Execute(Sorgu)
            S1.Range("A2").CopyFromRecordset Kayit_Seti
            S1.Columns.AutoFit
           
            Sorgu = "Select * From [" & S2.Name & "$]"
            Set Kayit_Seti = Baglanti.Execute(Sorgu)
            S2.Range("A2").CopyFromRecordset Kayit_Seti
            S2.Columns.AutoFit
           
            Sorgu = "Select * From [" & S3.Name & "$]"
            Set Kayit_Seti = Baglanti.Execute(Sorgu)
            S3.Range("A2").CopyFromRecordset Kayit_Seti
            S3.Columns.AutoFit
           
            If Kayit_Seti.State <> 0 Then Kayit_Seti.Close
            If Baglanti.State <> 0 Then Baglanti.Close
        End If
   
        Set Kayit_Seti = Nothing
        Set Baglanti = Nothing
        Set S1 = Nothing
        Set S2 = Nothing
        Set S3 = Nothing
           
        MsgBox "Veri aktarımı tamamlanmıştır." & Chr(10) & Chr(10) & _
               "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
    Else
        MsgBox "Dosya seçimi yapmadığınız için işlemini iptal edilmiştir.", vbCritical
    End If
End Sub

Korhan Ayhan Hocam. Baştaki
"""
Dosya = Application.GetOpenFilename(FileFilter:="Excel Çalışma Kitapları (*.xl*),*.xl*", _
Title:="Lütfen Dosya Seçiniz...", MultiSelect:=False)
"""
bu kod yerine adresi belli bir dosyadan almak istersek hangi kodu kullanmamız gerekiyor.

Korhan Ayhan · 16 Kasım 2020

Aşağıdaki gibi;

Dosya = "C:\Belgelerim\Aktarılacak Dosyanın Adı.xlsx"

kinikemrah · 16 Kasım 2020

Korhan Ayhan' Alıntı:
Aşağıdaki gibi;

Dosya = "C:\Belgelerim\Aktarılacak Dosyanın Adı.xlsx"

google drive dan bir doya almak istiyorum arada boşluk olduğu için hata mesajı veriyor bunu nasıl çözerim.

Korhan Ayhan · 16 Kasım 2020

Bu konuda bir tecrübem yok maalesef..

kinikemrah · 2 Aralık 2020

herkese merhabalar. korhan hocam bir çok deneme yaptım ama bir çözüm bulamadım.
Ben sizin paylaştığınız kodları kendime uyarladım.

Kod:

Sub Verileri_Aktar()
On Error GoTo Hata
    Dim Dosya As Variant, s1 As Worksheet, s2 As Worksheet, s3 As Worksheet, s4 As Worksheet, s5 As Worksheet, s6 As Worksheet, s7 As Worksheet
    Dim Baglanti As Object, Sorgu As String, Kayit_Seti As Object, Zaman As Double
    Dosya = "C:\Users\Admin\Google Drive\KINIK VERİTABANI EMRAH.xlsm"
   ' Dosya = Application.GetOpenFilename(FileFilter:="Excel Çalışma Kitapları (*.xl*),*.xl*", _
            Title:="Lütfen Dosya Seçiniz...", MultiSelect:=False)

    Zaman = Timer
   
    If Dosya <> False Then
        Set Baglanti = CreateObject("AdoDb.Connection")
        Set s1 = Sheets("ARACKONUM")
        Set s2 = Sheets("YÜKBİLGİSİ")
        Set s3 = Sheets("YUKSIPARIS")
        Set s4 = Sheets("ŞOFÖR VERİLER")
        Set s5 = Sheets("YETKİLİ VERİLER")
        Set s6 = Sheets("VERİ TABANI")
        Set s7 = Sheets("FİRMA VERİLER")
        s1.Range("A2:I" & s1.Rows.Count).ClearContents
        s2.Range("A2:T" & s2.Rows.Count).ClearContents
        s3.Range("A2:I" & s3.Rows.Count).ClearContents
        s4.Range("A2:X" & s4.Rows.Count).ClearContents
        s5.Range("A2:N" & s5.Rows.Count).ClearContents
        s6.Range("A2:X" & s5.Rows.Count).ClearContents
        s7.Range("A2:L" & s5.Rows.Count).ClearContents
        If Dosya <> ThisWorkbook.FullName Then
   
Baglanti.Open "Provider=Microsoft.Ace.OleDb.12.0;Data Source=" & Dosya & ";Extended Properties=""Excel 12.0;Hdr=YES"""

            Sorgu = "Select * From [" & s1.Name & "$]"
            Set Kayit_Seti = Baglanti.Execute(Sorgu)
            s1.Range("A2").CopyFromRecordset Kayit_Seti
            s1.Columns.AutoFit
           
            Sorgu = "Select * From [" & s2.Name & "$]"
            Set Kayit_Seti = Baglanti.Execute(Sorgu)
            s2.Range("A2").CopyFromRecordset Kayit_Seti
            s2.Columns.AutoFit
           
            Sorgu = "Select * From [" & s3.Name & "$]"
            Set Kayit_Seti = Baglanti.Execute(Sorgu)
            s3.Range("A2").CopyFromRecordset Kayit_Seti
            s3.Columns.AutoFit
               
            Sorgu = "Select * From [" & s4.Name & "$]"
            Set Kayit_Seti = Baglanti.Execute(Sorgu)
            s4.Range("A2").CopyFromRecordset Kayit_Seti
            s4.Columns.AutoFit
           
            Sorgu = "Select * From [" & s5.Name & "$]"
            Set Kayit_Seti = Baglanti.Execute(Sorgu)
            s5.Range("A2").CopyFromRecordset Kayit_Seti
            s5.Columns.AutoFit
           
            Sorgu = "Select * From [" & s6.Name & "$]"
            Set Kayit_Seti = Baglanti.Execute(Sorgu)
            s6.Range("A2").CopyFromRecordset Kayit_Seti
            s6.Columns.AutoFit
           
            Sorgu = "Select * From [" & s7.Name & "$]"
            Set Kayit_Seti = Baglanti.Execute(Sorgu)
            s7.Range("A2").CopyFromRecordset Kayit_Seti
            s7.Columns.AutoFit
           
            If Kayit_Seti.State <> 0 Then Kayit_Seti.Close
            If Baglanti.State <> 0 Then Baglanti.Close
        End If
       
        Set Kayit_Seti = Nothing
        Set Baglanti = Nothing
        Set s1 = Nothing
        Set s2 = Nothing
        Set s3 = Nothing
        Set s4 = Nothing
        Set s5 = Nothing
           Set s6 = Nothing
        Set s7 = Nothing
           
      '  MsgBox "Veri aktarımı tamamlanmıştır." & Chr(10) & Chr(10) & _
      '         "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
    Else
        MsgBox "Dosya seçimi yapmadığınız için işleminiz iptal edilmiştir.", vbCritical


Hata:  Dosya = "C:\Users\kinik\Google Drive\KINIK VERİTABANI EMRAH.xlsm"
   ' Dosya = Application.GetOpenFilename(FileFilter:="Excel Çalışma Kitapları (*.xl*),*.xl*", _
            Title:="Lütfen Dosya Seçiniz...", MultiSelect:=False)

   
    Zaman = Timer
   
    If Dosya <> False Then
        Set Baglanti = CreateObject("AdoDb.Connection")
        Set s1 = Sheets("ARACKONUM")
        Set s2 = Sheets("YÜKBİLGİSİ")
        Set s3 = Sheets("YUKSIPARIS")
        Set s4 = Sheets("ŞOFÖR VERİLER")
        Set s5 = Sheets("YETKİLİ VERİLER")
        Set s6 = Sheets("VERİ TABANI")
        Set s7 = Sheets("FİRMA VERİLER")
        s1.Range("A2:I" & s1.Rows.Count).ClearContents
        s2.Range("A2:T" & s2.Rows.Count).ClearContents
        s3.Range("A2:I" & s3.Rows.Count).ClearContents
        s4.Range("A2:X" & s4.Rows.Count).ClearContents
        s5.Range("A2:N" & s5.Rows.Count).ClearContents
        s6.Range("A2:X" & s5.Rows.Count).ClearContents
        s7.Range("A2:L" & s5.Rows.Count).ClearContents
        If Dosya <> ThisWorkbook.FullName Then
   
Baglanti.Open "Provider=Microsoft.Ace.OleDb.12.0;Data Source=" & Dosya & ";Extended Properties=""Excel 12.0;Hdr=YES"""

            Sorgu = "Select * From [" & s1.Name & "$]"
            Set Kayit_Seti = Baglanti.Execute(Sorgu)
            s1.Range("A2").CopyFromRecordset Kayit_Seti
            s1.Columns.AutoFit
           
            Sorgu = "Select * From [" & s2.Name & "$]"
            Set Kayit_Seti = Baglanti.Execute(Sorgu)
            s2.Range("A2").CopyFromRecordset Kayit_Seti
            s2.Columns.AutoFit
           
            Sorgu = "Select * From [" & s3.Name & "$]"
            Set Kayit_Seti = Baglanti.Execute(Sorgu)
            s3.Range("A2").CopyFromRecordset Kayit_Seti
            s3.Columns.AutoFit
               
            Sorgu = "Select * From [" & s4.Name & "$]"
            Set Kayit_Seti = Baglanti.Execute(Sorgu)
            s4.Range("A2").CopyFromRecordset Kayit_Seti
            s4.Columns.AutoFit
           
            Sorgu = "Select * From [" & s5.Name & "$]"
            Set Kayit_Seti = Baglanti.Execute(Sorgu)
            s5.Range("A2").CopyFromRecordset Kayit_Seti
            s5.Columns.AutoFit
           
            Sorgu = "Select * From [" & s6.Name & "$]"
            Set Kayit_Seti = Baglanti.Execute(Sorgu)
            s6.Range("A2").CopyFromRecordset Kayit_Seti
            s6.Columns.AutoFit
           
            Sorgu = "Select * From [" & s7.Name & "$]"
            Set Kayit_Seti = Baglanti.Execute(Sorgu)
            s7.Range("A2").CopyFromRecordset Kayit_Seti
            s7.Columns.AutoFit
           
            If Kayit_Seti.State <> 0 Then Kayit_Seti.Close
            If Baglanti.State <> 0 Then Baglanti.Close
        End If
     
        Set Kayit_Seti = Nothing
        Set Baglanti = Nothing
        Set s1 = Nothing
        Set s2 = Nothing
        Set s3 = Nothing
        Set s4 = Nothing
        Set s5 = Nothing
        Set s6 = Nothing
        Set s7 = Nothing
           
      '  MsgBox "Veri aktarımı tamamlanmıştır." & Chr(10) & Chr(10) & _
      '         "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
    Else
        MsgBox "Dosya seçimi yapmadığınız için işleminiz iptal edilmiştir.", vbCritical

     End If

   End If
'Application.Wait "00:00:05"
End Sub

bu şekilde birden çok bilgisayardan google drive üzeri veri çekebiliyorum. Burda bir sıkıntı yok.ilkinde hata alırsa 2. kod işliyor.

kinikemrah · 2 Aralık 2020

Veri çektiğim dosyada bir tane daha var. onun için oluşturduğum kodlar ise şu şekilde. yani isteğim şu. Verileri_aktar çalıştıktan sonra Verileri_aktar2 dosyası da başka bir Dosya yolundan Verileri_aktar den sonraki hücreye yine aynı benzer kodlar ile farklı bir dosyadan veri çekmek istiyorum. Kodlar.

Kod:

Sub Verileri_Aktar2()
On Error GoTo Hata
    Dim Dosya1 As Variant, s1 As Worksheet, s2 As Worksheet, s3 As Worksheet
    Dim Baglanti1 As Object, Sorgu1 As String, Kayit_Seti1 As Object, Zaman1 As Double
   Dim SonSat As Long
    Dosya1 = "C:\Users\Admin\Google Drive\KINIK VERİTABANI NEDİM.xlsm"
   ' Dosya = Application.GetOpenFilename(FileFilter:="Excel Çalışma Kitapları (*.xl*),*.xl*", _



    Zaman1 = Timer
   
    If Dosya1 <> False Then
        Set Baglanti1 = CreateObject("AdoDb.Connection")
        Set s1 = Sheets("ARACKONUM")
        Set s2 = Sheets("YÜKBİLGİSİ")
        Set s3 = Sheets("YUKSIPARIS")
 
       
 
        If Dosya1 <> ThisWorkbook.FullName Then
   
Baglanti1.Open "Provider=Microsoft.Ace.OleDb.12.0;Data Source=" & Dosya1 & ";Extended Properties=""Excel 12.0;Hdr=YES"""

            Sorgu1 = "Select * From [" & s1.Name & "$]"
            Set Kayit_Seti1 = Baglanti1.Execute(Sorgu1)
            s1.Range("A" & Rows.Count).End(xlUp).Row.CopyFromRecordset Kayit_Seti1
            s1.Columns.AutoFit
           
            Sorgu1 = "Select * From [" & s2.Name & "$]"
            Set Kayit_Seti1 = Baglanti1.Execute(Sorgu1)
            s2.SonSat.CopyFromRecordset Kayit_Seti1
            s2.Columns.AutoFit
           
            Sorgu1 = "Select * From [" & s3.Name & "$]"
            Set Kayit_Seti1 = Baglanti1.Execute(Sorgu1)
            s3.SonSat.CopyFromRecordset Kayit_Seti1
            s3.Columns.AutoFit
               

           
            If Kayit_Seti1.State <> 0 Then Kayit_Seti1.Close
            If Baglanti1.State <> 0 Then Baglanti1.Close
        End If
         izlemeDosyasi.Show
        Set Kayit_Seti1 = Nothing
        Set Baglanti1 = Nothing
        Set s1 = Nothing
        Set s2 = Nothing
        Set s3 = Nothing
 
           
      '  MsgBox "Veri aktarımı tamamlanmıştır." & Chr(10) & Chr(10) & _
      '         "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
    Else
        MsgBox "Dosya seçimi yapmadığınız için işleminiz iptal edilmiştir.", vbCritical


Hata:  Dosya1 = "C:\Users\kinik\Google Drive\KINIK VERİTABANI NEDİM.xlsm"
   ' Dosya = Application.GetOpenFilename(FileFilter:="Excel Çalışma Kitapları (*.xl*),*.xl*", _
            Title:="Lütfen Dosya Seçiniz...", MultiSelect:=False)

   
    Zaman = Timer
   
    If Dosya1 <> False Then
        Set Baglanti1 = CreateObject("AdoDb.Connection")
        Set s1 = Sheets("ARACKONUM")
        Set s2 = Sheets("YÜKBİLGİSİ")
        Set s3 = Sheets("YUKSIPARIS")

 

        If Dosya1 <> ThisWorkbook.FullName Then
   
Baglanti1.Open "Provider=Microsoft.Ace.OleDb.12.0;Data Source=" & Dosya1 & ";Extended Properties=""Excel 12.0;Hdr=YES"""

            Sorgu1 = "Select * From [" & s1.Name & "$]"
            Set Kayit_Seti1 = Baglanti1.Execute(Sorgu1)
            s1.Range("A2").CopyFromRecordset Kayit_Seti1
            s1.Columns.AutoFit
           
            Sorgu1 = "Select * From [" & s2.Name & "$]"
            Set Kayit_Seti1 = Baglanti1.Execute(Sorgu1)
            s2.SonSat.CopyFromRecordset Kayit_Seti1
            s2.Columns.AutoFit
           
            Sorgu1 = "Select * From [" & s3.Name & "$]"
            Set Kayit_Seti1 = Baglanti1.Execute(Sorgu1)
            s3.SonSat.CopyFromRecordset Kayit_Seti1
            s3.Columns.AutoFit
               

           
            If Kayit_Seti1.State <> 0 Then Kayit_Seti1.Close
            If Baglanti1.State <> 0 Then Baglanti1.Close
        End If
         izlemeDosyasi.Show
        Set Kayit_Seti1 = Nothing
        Set Baglanti1 = Nothing
        Set s1 = Nothing
        Set s2 = Nothing
        Set s3 = Nothing

           
      '  MsgBox "Veri aktarımı tamamlanmıştır." & Chr(10) & Chr(10) & _
      '         "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
    Else
        MsgBox "Dosya seçimi yapmadığınız için işleminiz iptal edilmiştir.", vbCritical

     End If

   End If

End Sub

şimdi clearContent çalıştırmıyorum verileri_aktar2 de
şuraya da en son dolu hücreden sonrakini seç diyeceğim. ama onu halledemiyorum.

Kod:

Sorgu1 = "Select * From [" & s1.Name & "$]"

            Set Kayit_Seti1 = Baglanti1.Execute(Sorgu1)
------->>>>>s1.Range("A" & Rows.Count).End(xlUp).Row.CopyFromRecordset Kayit_Seti1
            s1.Columns.AutoFit

Yardımlarını bekliyor olacağım. varsa bir çözümünüz şimdiden teşekkürler.

Korhan Ayhan · 3 Aralık 2020

Şöyle deneyiniz.

s1.Range("A" & Rows.Count).End(3)(2, 1).CopyFromRecordset Kayit_Seti1

kinikemrah · 3 Aralık 2020

oldu hocam. daha çok yolumuz var demekki.

kinikemrah · 3 Aralık 2020

On Error GoTo Hata
hata: kodları doğru kullanmışıyım yoksa gelişi güzel mi çalışıyor. bir fikriniz olurmu.

Haluk · 3 Aralık 2020

kinikemrah' Alıntı:
google drive dan bir doya almak istiyorum arada boşluk olduğu için hata mesajı veriyor bunu nasıl çözerim.

Google Drive'daki dosyalara, ID'leri ile başvurursunuz, dosya isimleri ile değil .... ID'lerin kullanıldığı URL'de zaten boşluk da bulunmaz.

.

Korhan Ayhan · 3 Aralık 2020

Kurduğunuz yapıyı komple incelemedim. Sadece veriyi alta devam ettirme yönünde öneride bulundum.

Neyi nereye aktardığınızı örnek dosya ekleyerek açıklarsanız belki kodlar daha kısa tasarlanabilir.

Excelden başka bir excele veri aktarmak

eda arık

cemshan

eda arık

Korhan Ayhan

Administrator

eda arık

kinikemrah

Korhan Ayhan

Administrator

kinikemrah

Korhan Ayhan

Administrator

kinikemrah

kinikemrah

Korhan Ayhan

Administrator

kinikemrah

kinikemrah

Haluk

Özel Üye

Korhan Ayhan

Administrator