dosyadan dosyaya veri çekme

incsoft

Altın Üye
Katılım
18 Ağustos 2009
Mesajlar
724
Excel Vers. ve Dili
Office Ev ve İş 2021 - Türkçe
Arkadaşlar elimde sürekli değişkenlik göstermekte olan export.xlsx adı altında bir dosyam var ve bu dosyanın Sheet1 sayfasının =A:R aralığını kopyalayarak KONTROL2018.xlsx dosyamdaki DATA kısmında bulunan aynı =A:R alanına yapıştırmak istiyorum. Bunu her zaman sürekli elle kopyala yapıştır aracılığıyla yapıyorum kendim basit bir komut kaydı yaparak aktardım ama karışıyor. Bunu bir buton aracılığıyla nasıl yaptırabilirim? Meslea KONTROL2018.xlsx dosyama 1 buton koyacam verileri al dediğimde export.xlsx dosyam açık ya da kapalı farketmez otomatik olarak verileri oraya aktaracak. Siz uzman arkadaşlarımın bilgilerine ihtiyacım vardır.

Teşekkürler..
 

Hakan ERDOST

Destek Ekibi
Destek Ekibi
Katılım
12 Eylül 2004
Mesajlar
870
Excel Vers. ve Dili
Excel 2019 Türkçe (Ev)
Excel 2013 Türkçe (Okul)
Dosyanız ekte , kendinize uyarlarsınız.
 

Ekli dosyalar

incsoft

Altın Üye
Katılım
18 Ağustos 2009
Mesajlar
724
Excel Vers. ve Dili
Office Ev ve İş 2021 - Türkçe
Dosyanız ekte , kendinize uyarlarsınız.

Sub aktar()
Dim Con As Object, Rs As Object, Sorgu As String
Set Con = CreateObject("Adodb.Connection")
Set Rs = CreateObject("Adodb.RecordSet")
Con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
ThisWorkbook.Path & "\export.XLSX" & ";extended properties=""excel 12.0;hdr=no"""
Sorgu = "Select * from [Sheet1$a1:R2000]"
Rs.Open Sorgu, Con, 1, 1
Sheets("Data1").Range("a1").CopyFromRecordset Rs
Rs.Close: Con.Close
End Sub



Private Sub CommandButton1_Click()
Call aktar
End Sub



Neden böyle hata veriyor hocam?
 

Ekli dosyalar

Hakan ERDOST

Destek Ekibi
Destek Ekibi
Katılım
12 Eylül 2004
Mesajlar
870
Excel Vers. ve Dili
Excel 2019 Türkçe (Ev)
Excel 2013 Türkçe (Okul)
Ofis sürümünüz nedir? Excel kaç sürümü kullanıyorsunuz?


Tapatalk kullanarak iPhone aracılığıyla gönderildi
 

incsoft

Altın Üye
Katılım
18 Ağustos 2009
Mesajlar
724
Excel Vers. ve Dili
Office Ev ve İş 2021 - Türkçe

Hakan ERDOST

Destek Ekibi
Destek Ekibi
Katılım
12 Eylül 2004
Mesajlar
870
Excel Vers. ve Dili
Excel 2019 Türkçe (Ev)
Excel 2013 Türkçe (Okul)
Ben de herhangi bir hata vermedi. Kodda bir değişiklik yaptınız mı?


Tapatalk kullanarak iPhone aracılığıyla gönderildi
 

incsoft

Altın Üye
Katılım
18 Ağustos 2009
Mesajlar
724
Excel Vers. ve Dili
Office Ev ve İş 2021 - Türkçe
Ben de herhangi bir hata vermedi. Kodda bir değişiklik yaptınız mı?


Tapatalk kullanarak iPhone aracılığıyla gönderildi
sizin dosya da çalışıyor hocam ama kendime uyarlayınca neden hata veriyor anlamadım. İnceliyorum
 

incsoft

Altın Üye
Katılım
18 Ağustos 2009
Mesajlar
724
Excel Vers. ve Dili
Office Ev ve İş 2021 - Türkçe
Ben de herhangi bir hata vermedi. Kodda bir değişiklik yaptınız mı?


Tapatalk kullanarak iPhone aracılığıyla gönderildi
Hocam mümkünse dosyamı incelebilirmisiniz? Dosyam masaüstünde bulunan export.XLSX dosyasından alıyor. Sizinkiler sorunsuz çalışıyor

Teşekkürler.
 

Ekli dosyalar

Hakan ERDOST

Destek Ekibi
Destek Ekibi
Katılım
12 Eylül 2004
Mesajlar
870
Excel Vers. ve Dili
Excel 2019 Türkçe (Ev)
Excel 2013 Türkçe (Okul)
Dışarıdayım şu an, bilgisayara geçince bakarım


Tapatalk kullanarak iPhone aracılığıyla gönderildi
 

Hakan ERDOST

Destek Ekibi
Destek Ekibi
Katılım
12 Eylül 2004
Mesajlar
870
Excel Vers. ve Dili
Excel 2019 Türkçe (Ev)
Excel 2013 Türkçe (Okul)
Hocam mümkünse dosyamı incelebilirmisiniz? Dosyam masaüstünde bulunan export.XLSX dosyasından alıyor. Sizinkiler sorunsuz çalışıyor

Teşekkürler.
Dosyanızın son hali ekte, inceleyiniz. Aralık tanımlamada hata yapmışsınız.

Sütun başlıklarının üzerine yazılmasını istemiyorsanız kodun Data sayfası ile ilgili böülmdeki A1 'i A2 yapabilirsiniz.
 

Ekli dosyalar

incsoft

Altın Üye
Katılım
18 Ağustos 2009
Mesajlar
724
Excel Vers. ve Dili
Office Ev ve İş 2021 - Türkçe
Dosyanızın son hali ekte, inceleyiniz. Aralık tanımlamada hata yapmışsınız.

Sütun başlıklarının üzerine yazılmasını istemiyorsanız kodun Data sayfası ile ilgili böülmdeki A1 'i A2 yapabilirsiniz.
çok teşekkürler hocam
 

Hakan ERDOST

Destek Ekibi
Destek Ekibi
Katılım
12 Eylül 2004
Mesajlar
870
Excel Vers. ve Dili
Excel 2019 Türkçe (Ev)
Excel 2013 Türkçe (Okul)
Rica ederim. İyi akşamlar.
 

Hakan ERDOST

Destek Ekibi
Destek Ekibi
Katılım
12 Eylül 2004
Mesajlar
870
Excel Vers. ve Dili
Excel 2019 Türkçe (Ev)
Excel 2013 Türkçe (Okul)
Kodlar yenilendi. Deneyiniz.
 

Ekli dosyalar

incsoft

Altın Üye
Katılım
18 Ağustos 2009
Mesajlar
724
Excel Vers. ve Dili
Office Ev ve İş 2021 - Türkçe
Kodlar yenilendi. Deneyiniz.
Verileri hep bir öncekinin altına atıyor hocam bu sebepten dolayı aşağıdaki gibi bir kod ekledim ancak sanki biraz yavaşlattı buda.. Her butona tıklantığında bir önceki verilerin tamamen revize edilmesi gerekiyor alt alta eklenmemesi gerekiyor. Bu mantık doğrumu yoksa başka ne yapılabilir? Çok teşekkür ederim...

Columns("A:R").Select
Selection.ClearContents
ActiveWindow.SmallScroll Down:=-6
Range("A1").Select
 

Hakan ERDOST

Destek Ekibi
Destek Ekibi
Katılım
12 Eylül 2004
Mesajlar
870
Excel Vers. ve Dili
Excel 2019 Türkçe (Ev)
Excel 2013 Türkçe (Okul)
Kodu aşağıdaki şekilde değiştirin.
Kod:
Private Sub CommandButton1_Click()
Dim conn As Object, rs As Object
Set conn = CreateObject("adodb.connection")
Set rs = CreateObject("adodb.recordset")
conn.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
        ThisWorkbook.Path & "\export.xlsx;extended properties=""excel 12.0;hdr=no;imex1"""
rs.Open "select * from [Sheet1$];", conn, 1, 3
Application.ScreenUpdating = False
If rs.RecordCount > 0 Then Range("A1").CopyFromRecordset rs
Application.ScreenUpdating = True
rs.Close
conn.Close
Set rs = Nothing:  Set conn = Nothing
MsgBox "Veriler aktarıldı."
End Sub
 

incsoft

Altın Üye
Katılım
18 Ağustos 2009
Mesajlar
724
Excel Vers. ve Dili
Office Ev ve İş 2021 - Türkçe
Dim conn As Object, rs As Object Set conn = CreateObject("adodb.connection") Set rs = CreateObject("adodb.recordset") conn.Open "provider=microsoft.ace.oledb.12.0;data source=" & _ ThisWorkbook.Path & "\export.xlsx;extended properties=""excel 12.0;hdr=no;imex1""" rs.Open "select * from [Sheet1$];", conn, 1, 3 Application.ScreenUpdating = False If rs.RecordCount > 0 Then Range("A1").CopyFromRecordset rs Application.ScreenUpdating = True rs.Close conn.Close Set rs = Nothing: Set conn = Nothing MsgBox "Veriler aktarıldı."
Çok teşekkürler.. Sizler nasıl hemen kodları geliştirmektesiniz hocam ben bir türlü çözemiyorum..
 

incsoft

Altın Üye
Katılım
18 Ağustos 2009
Mesajlar
724
Excel Vers. ve Dili
Office Ev ve İş 2021 - Türkçe
Kodu aşağıdaki şekilde değiştirin.
Kod:
Private Sub CommandButton1_Click()
Dim conn As Object, rs As Object
Set conn = CreateObject("adodb.connection")
Set rs = CreateObject("adodb.recordset")
conn.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
        ThisWorkbook.Path & "\export.xlsx;extended properties=""excel 12.0;hdr=no;imex1"""
rs.Open "select * from [Sheet1$];", conn, 1, 3
Application.ScreenUpdating = False
If rs.RecordCount > 0 Then Range("A1").CopyFromRecordset rs
Application.ScreenUpdating = True
rs.Close
conn.Close
Set rs = Nothing:  Set conn = Nothing
MsgBox "Veriler aktarıldı."
End Sub


Hocam bu hatayı veriyor bunu da dosya ağda çalıştığından dolayı veriyor. Bu dosyayı ortak olarak kullanmaktayız. Ağ bilgisayarında nasıl kullanabiliriz? Yerel bilgisayarımda kullandımı bir sorun yok...
 

Ekli dosyalar

incsoft

Altın Üye
Katılım
18 Ağustos 2009
Mesajlar
724
Excel Vers. ve Dili
Office Ev ve İş 2021 - Türkçe
Birde hocam mesela P sütunumun içeriği 11:20:32 şeklindedir bunu birebir değilde 00.01.1900 11:20:32 şeklinde atmaktadır. Bu şekilde birebir sayfa yapısını da bozmadan aktarma yapabilirmiyiz?


1547122648616.png


1547122599349.png
 

Hakan ERDOST

Destek Ekibi
Destek Ekibi
Katılım
12 Eylül 2004
Mesajlar
870
Excel Vers. ve Dili
Excel 2019 Türkçe (Ev)
Excel 2013 Türkçe (Okul)
Kod:
Private Sub CommandButton1_Click()
 Set Con = CreateObject("Adodb.connection")
    Set rs = CreateObject("Adodb.recordset")
    'yol = "\\denemeserver\denemedosya\"
     yol = "C:\Desktop\"
    Con.Open "provider=microsoft.ACE.oledb.12.0;data source=" & yol & "export.xlsx" & _
     ";extended properties=""Excel 8.0;hdr=yes"""
    Sorgu = "SELECT * FROM [Sheet1$]"
    rs.Open Sorgu, Con, 1, 1
    Range("a2").CopyFromRecordset rs
    rs.Close: Con.Close
    Set Con = Nothing: Set rs = Nothing
End Sub
Kodda bulunan yolu değiştirerek deneyiniz. Tek tırnak yolu kendi server adresine göre düzenleyebilirisiniz.
 
Üst