Kapalı dosyadan buton ile veri alma.

schlecht · 8 Temmuz 2018

İyi akşamlar. Ekte bununan;
Kapalı.xlsx dosyasnındaki A sütununu, Açık.xlsm dosyasındaki H sütununa,
Kapalı.xlsx dosyasnındaki F sütununu, Açık.xlsm dosyasındaki I sütununa,
buton yardımı ile kopyalmak istiyorum. Dosyalar aynı dizinde değil ve kapalı.xlsx dosya ismi değişken fakat sütunlar sabit, veriler yukarıdaki gibi. Forumda araştırma yaptım fakat uygun örnek bulamadım.

Yardımlarınızı rica ediyorum,

Teşekkürler.

schlecht · 8 Temmuz 2018

İyi akşamlar yardımcı olabilecek biri var mı acaba, elinde örnek olan?

Teşekkürler.

Orion1 · 8 Temmuz 2018

Açık dosyanızın bulunduğu yeri kodlardaki yol değişkenine yazınız.
Dosyanız ektedir.

DOSYAYI INDIR

Kod:

Sub Düğme1_Tıklat()
Dim conn As Object, rs As Object, yol As String
Range("H2:I" & Rows.Count).ClearContents
Set conn = CreateObject("Adodb.Connection")
Set rs = CreateObject("Adodb.Recordset")
'Yol yerine kendi yolunuzu giriniz.
yol = ThisWorkbook.Path
conn.Open "Provider=microsoft.ace.oledb.12.0;data source=" & yol & "\Kapalı.xlsx;extended properties=""excel 12.0;hdr=yes"";"
rs.Open "Select [Başlık 1],[Başlık 2] from [Sayfa1$A1:F" & Rows.Count & "]", conn, 1, 1
If rs.RecordCount > 0 Then Range("H2").CopyFromRecordset rs
rs.Close: conn.Close
MsgBox "Aktarma yapıldı."
End Sub

schlecht · 8 Temmuz 2018

Hocam cevabınız için teşekkür ederim. Fakat sorumda da belirttiğim gibi "Dosyalar aynı dizinde değil ve kapalı.xlsx dosya ismi değişken " kapalı olacak dosyayı seçmem gerekiyor. Formülü bu şekilde düzenlemek mümkün mü?

Orion1 · 8 Temmuz 2018

Kodları aşağıdaki ile değiştiriniz.

Kod:

Sub Düğme1_Tıklat()
Dim conn As Object, rs As Object, yol As String, dosya
Range("H2:I" & Rows.Count).ClearContents
Set conn = CreateObject("Adodb.Connection")
Set rs = CreateObject("Adodb.Recordset")
ChDir (ThisWorkbook.Path)
dosya = Application.GetOpenFilename("Excel Dosyaları,xlsx", , "LÜTFEN DOSYAYI SEÇİNİZ")
conn.Open "Provider=microsoft.ace.oledb.12.0;data source=" & dosya & ";extended properties=""excel 12.0;hdr=yes"";"
rs.Open "Select [Başlık 1],[Başlık 2] from [Sayfa1$A1:F" & Rows.Count & "]", conn, 1, 1
If rs.RecordCount > 0 Then Range("H2").CopyFromRecordset rs
rs.Close: conn.Close
MsgBox "Aktarma yapıldı."
End Sub

schlecht · 8 Temmuz 2018

Hocam çok teşekkür ederim. Tam istediğim gibi çalıştı. Çok işime yaradı inanın.

Orion1 · 8 Temmuz 2018

schlecht' Alıntı:
Hocam çok teşekkür ederim. Tam istediğim gibi çalıştı. Çok işime yaradı inanın.

Rica ederim.
İyi çalışmalar.

akicimen · 13 Kasım 2020

BAZI HÜCREDEKİ VERİLER AKTARILMIYOR. AYNI SÜTUNDAKİ BAZI HÜCRELER GELİYOR AMA BAZI HÜCRELER DİĞER EXCELE AKTARILMIYOR. HÜCRE BİÇİMİYLE ALAKASI VAR MIDIR?

Korhan Ayhan · 13 Kasım 2020

Lütfen bağırmayınız ve forum kurallarını okuyunuz.

muratgunay48 · 13 Kasım 2020

Orion1' Alıntı:

Kodları aşağıdaki ile değiştiriniz.

Kod:

Sub Düğme1_Tıklat()
Dim conn As Object, rs As Object, yol As String, dosya
Range("H2:I" & Rows.Count).ClearContents
Set conn = CreateObject("Adodb.Connection")
Set rs = CreateObject("Adodb.Recordset")
ChDir (ThisWorkbook.Path)
dosya = Application.GetOpenFilename("Excel Dosyaları,xlsx", , "LÜTFEN DOSYAYI SEÇİNİZ")
conn.Open "Provider=microsoft.ace.oledb.12.0;data source=" & dosya & ";extended properties=""excel 12.0;hdr=yes"";"
rs.Open "Select [Başlık 1],[Başlık 2] from [Sayfa1$A1:F" & Rows.Count & "]", conn, 1, 1
If rs.RecordCount > 0 Then Range("H2").CopyFromRecordset rs
rs.Close: conn.Close
MsgBox "Aktarma yapıldı."
End Sub

Hocam çok güzel bir çalışma, emeğinize sağlık. Kullanmak istersek. Alacağı ve kopyalayacağı sütunları nasıl değiştirebiliriz. Mesela A'ya getirdim ama mutlaka B'ye geliyor. O değişkenler nelerdir. Mesela C F'ye D L'ye gelsin dersek.
Saygılarımla

Korhan Ayhan · 13 Kasım 2020

Sorgu satırını düzenlemek gerekir. Bunun içinde tablonuzu görmek gerekir.

muratgunay48 · 14 Kasım 2020

Korhan Ayhan' Alıntı:
Sorgu satırını düzenlemek gerekir. Bunun içinde tablonuzu görmek gerekir.

Hocam, öğrenmek en iyisi. Sizler sayesinde her gün bir şeyler daha öğrenmeye çalışıyoruz. Dosya görmek demişsiniz. Ben arkadaşın dosyasını kopyaladım, sadece sütun değiştirdim. @Orion1 hocamın yazdığı kod benim dosyalarım için nasıl uyarlanır. Bir kere görsem değişkenleri.
Saygılarımla.

Korhan Ayhan · 15 Kasım 2020

ADO ile işlem yapacaksanız veri tabanı kurallarına uymanız gerekiyor. yoksa sorunlar yaşamanız muhtemeldir.

Deneyiniz.

C++:

Option Explicit

Sub Düğme1_Tıklat()
    Dim Baglanti As Object, Kayit_Seti As Object, Sorgu As String
    Dim Yol As String, Dosya As String, Zaman As Double
    
    Zaman = Timer
    
    Set Baglanti = CreateObject("Adodb.Connection")
    Set Kayit_Seti = CreateObject("Adodb.Recordset")
    
    Range("E2:E" & Rows.Count).ClearContents
    Range("G2:G" & Rows.Count).ClearContents
    
    Yol = ThisWorkbook.Path & Application.PathSeparator
    Dosya = Yol & "Kapalı - Kopya.xlsx"
    
    Baglanti.Open "Provider=Microsoft.Ace.OleDb.12.0;Data Source=" & _
    Dosya & ";Extended Properties=""Excel 12.0;Hdr=No"""
    
    Sorgu = "Select [Başlık 1], '', [Başlık 2] From [Sayfa1$]"
    
    Kayit_Seti.Open Sorgu, Baglanti, 1, 1
    
    If Kayit_Seti.RecordCount > 0 Then Range("E2").CopyFromRecordset Kayit_Seti
    
    If Kayit_Seti.State <> 0 Then Kayit_Seti.Close
    If Baglanti.State <> 0 Then Baglanti.Close
    
    Set Baglanti = Nothing
    Set Kayit_Seti = Nothing
    
    MsgBox "Veri aktarımı tamamlanmıştır." & Chr(10) & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
End Sub

muratgunay48 · 15 Kasım 2020

Korhan Ayhan' Alıntı:

ADO ile işlem yapacaksanız veri tabanı kurallarına uymanız gerekiyor. yoksa sorunlar yaşamanız muhtemeldir.

Deneyiniz.

C++:

Option Explicit

Sub Düğme1_Tıklat()
    Dim Baglanti As Object, Kayit_Seti As Object, Sorgu As String
    Dim Yol As String, Dosya As String, Zaman As Double
   
    Zaman = Timer
   
    Set Baglanti = CreateObject("Adodb.Connection")
    Set Kayit_Seti = CreateObject("Adodb.Recordset")
   
    Range("E2:E" & Rows.Count).ClearContents
    Range("G2:G" & Rows.Count).ClearContents
   
    Yol = ThisWorkbook.Path & Application.PathSeparator
    Dosya = Yol & "Kapalı - Kopya.xlsx"
   
    Baglanti.Open "Provider=Microsoft.Ace.OleDb.12.0;Data Source=" & _
    Dosya & ";Extended Properties=""Excel 12.0;Hdr=No"""
   
    Sorgu = "Select [Başlık 1], '', [Başlık 2] From [Sayfa1$]"
   
    Kayit_Seti.Open Sorgu, Baglanti, 1, 1
   
    If Kayit_Seti.RecordCount > 0 Then Range("E2").CopyFromRecordset Kayit_Seti
   
    If Kayit_Seti.State <> 0 Then Kayit_Seti.Close
    If Baglanti.State <> 0 Then Baglanti.Close
   
    Set Baglanti = Nothing
    Set Kayit_Seti = Nothing
   
    MsgBox "Veri aktarımı tamamlanmıştır." & Chr(10) & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
End Sub

Teşekkür ederim hocam.

muratgunay48 · 15 Kasım 2020

Orion1' Alıntı:

Kodları aşağıdaki ile değiştiriniz.

Kod:

Sub Düğme1_Tıklat()
Dim conn As Object, rs As Object, yol As String, dosya
Range("H2:I" & Rows.Count).ClearContents
Set conn = CreateObject("Adodb.Connection")
Set rs = CreateObject("Adodb.Recordset")
ChDir (ThisWorkbook.Path)
dosya = Application.GetOpenFilename("Excel Dosyaları,xlsx", , "LÜTFEN DOSYAYI SEÇİNİZ")
conn.Open "Provider=microsoft.ace.oledb.12.0;data source=" & dosya & ";extended properties=""excel 12.0;hdr=yes"";"
rs.Open "Select [Başlık 1],[Başlık 2] from [Sayfa1$A1:F" & Rows.Count & "]", conn, 1, 1
If rs.RecordCount > 0 Then Range("H2").CopyFromRecordset rs
rs.Close: conn.Close
MsgBox "Aktarma yapıldı."
End Sub

Hocam, öncelikle tekrar emeğinize sağlık. Şimdi kodda ("H2") yazan yer. H sütünü ve hemen yanına atıyor. H'yi A yapsam A ve hemen yanına B'ye atıyor. Peki A ve C sütununa atmasını istesem ("H") yerine ne yazmam lazım.

Korhan Ayhan · 15 Kasım 2020

ADO veritabanı uygulamalarında kullanılan bir yapıdır.

Boş satırların, boş sütunların, birleştirilmiş hücrelerin olduğu tablolarda kullanılabiliyor fakat sıkıntı çıkabiliyor.

Evren beyin önerdiği koddaki sorguyu iki kez çalıştırıp gelen kayıt setlerini istediğiniz hücreye aktarabilirsiniz.

Örnek;

C++:

rs.Open "Select [Başlık 1] from [Sayfa1$A1:F" & Rows.Count & "]", conn, 1, 1
If rs.RecordCount > 0 Then Range("A2").CopyFromRecordset rs
rs.Close
rs.Open "Select [Başlık 2] from [Sayfa1$A1:F" & Rows.Count & "]", conn, 1, 1
If rs.RecordCount > 0 Then Range("C2").CopyFromRecordset rs
rs.Close: conn.Close

muratgunay48 · 16 Kasım 2020

Korhan Ayhan' Alıntı:
ADO veritabanı uygulamalarında kullanılan bir yapıdır.

Boş satırların, boş sütunların, birleştirilmiş hücrelerin olduğu tablolarda kullanılabiliyor fakat sıkıntı çıkabiliyor.

Evren beyin önerdiği koddaki sorguyu iki kez çalıştırıp gelen kayıt setlerini istediğiniz hücreye aktarabilirsiniz.

Örnek;

C++:

rs.Open "Select [Başlık 1] from [Sayfa1$A1:F" & Rows.Count & "]", conn, 1, 1 If rs.RecordCount > 0 Then Range("A2").CopyFromRecordset rs rs.Close rs.Open "Select [Başlık 2] from [Sayfa1$A1:F" & Rows.Count & "]", conn, 1, 1 If rs.RecordCount > 0 Then Range("C2").CopyFromRecordset rs rs.Close: conn.Close

Çok teşekkür ederim hocam. Varolun. Sayenizde hep bir adım daha ileri gidiyoruz.
Saygılarımla.

Grknpkdzn · 12 Mayıs 2021

Değerli üstatlar ve excel severler.
Bu konu ile alakalı bende bir destek rica ediyorum.
Elimde AYLIK MESAİ TALEP FORMU.XLSX dosyam var.
Bir de ayın günleri ile başlayan günlük dosyalarım var.
Yapmak istediğim,
AYLIK MESAİ TALEP FORMU 'nun içinde, "İÇERİ AKTAR..!" butonuna tıklayarak, kapalı olan dosyalardan dataları çektirip bu aylık dosyanın içerisine toplamak.
Not: Tüm bu dosyalar, tek bir klasörün içerisinde bulunmaktadırlar..
Şimdiden teşekkür eder, hayırlı bayramlar dilerim.
[URL=https://dosya.co/ho3zrh0r0s9t/01.05.21_MESAİ_LİSTESİ_TALEP_FORMU.XLSX.html]01.05.21 MESAİ LİSTESİ TALEP FORMU.XLSX - 17 KB 02.05.21 MESAİ LİSTESİ TALEP FORMU.XLSX - 17 KB AYLIK MESAİ TALEP FORMU.XLSX - 21 KB[/URL]

Korhan Ayhan · 13 Mayıs 2021

Birleştirme işlemi yapılacak dosyada 100 satırlık bir tablo oluşturmuşsunuz. Aktarılacak veriler bu 100 satırı geçme ihtimali var mı?

Varsa tablonuzun altındaki unvan bölümü silinecektir.

Korhan Ayhan · 13 Mayıs 2021

Ben dosyanızı 2500 satırlık olacak şekilde düzenledim.

Sanırım bu haliyle yeterli olacaktır.

İşlem sonunda boş satırlar otomatik gizlenmektedir.

Kapalı dosyadan buton ile veri alma.

schlecht

Ekli dosyalar

schlecht

Orion1

Uzman

Ekli dosyalar

schlecht

Orion1

Uzman

schlecht

Orion1

Uzman

akicimen

Korhan Ayhan

Administrator

muratgunay48

Korhan Ayhan

Administrator

muratgunay48

Ekli dosyalar

Korhan Ayhan

Administrator

muratgunay48

muratgunay48

Ekli dosyalar

Korhan Ayhan

Administrator

muratgunay48

Grknpkdzn

Ekli dosyalar

Korhan Ayhan

Administrator

Korhan Ayhan

Administrator

Ekli dosyalar