• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Kapalı dosyadan buton ile veri alma.

Kodun aşağıdaki satırı temizleme işlemi yapıyor.

Range("H2:I" & Rows.Count).ClearContents

H2 hücresinden başlıyor I sütunu son satıra kadar temizlene yapıyor.

Aşağıdaki satırda kayıt setini H2 hücresinden itibaren hücreye aktarıyor.

Range("H2").CopyFromRecordset rs
 
Korhan bey 1 ve 2 aktarma makrolari ile istedigim sekilde aktariyorum burada sorun yok. Ancak aktarma 1 makrosunu tekrar calistırıram makro2 nin bilgilerinide siliyor. Makrolarda silinecek yani H2:I bölgesini H2:I11 olarak kabul etmiyor, bunu nasil cözebiliriz. Tsk ederim.
 
Tasarladığınız kodu ya da örnek dosyalarınızı ekleyip açıklarsanız daha hızlı yanıt alırsınız.
 
Merhaba arkadaslar... asagıdaki makro sorunsuz calısıyor ancak acılan dosya ac ekranında iptal dedigimizde makro hata veriyor... nereye ekleme yapabiliriz...
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
 
Deneyiniz.

C++: 
Option Explicit

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")
    If dosya = False Then
        MsgBox "Dosya seçimi yapmadığınız için işleminiz iptal edilmiştir.", vbExclamation
        Exit Sub
    End If
    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
 
Herkese merhabalar, bende kapalı ANA-DOSYA.xlsm adında uzantısını bıldıgım bir dosyadan veri almak istiyorum nasıl yapabilirim? şimdiden teşekkür ederim.
 
Korhan bey merhaba,

Aşağıdaki koda "select" kısmına üçüncü bir başlık eklemek istediğimde hata alıyorum. Sadece 2 sütundaki verileri aktarıyor. Ama üçüncü bir sütun için "Select [Stok Adı],[Temel Mik.],[Tutarı (KDV Dahil)] from...aralıkta bulunan bir başlık daha eklediğimde geçerli bir ad değil hatası alıyorum. Yardımcı olabilirseniz çok memnun olurum.

Sub Düğme1_Tıklat()
Dim conn As Object, rs As Object, yol As String
Sheets("veri").Range("A2:C" & Rows.Count).ClearContents
Set conn = CreateObject("Adodb.Connection")
Set rs = CreateObject("Adodb.Recordset")

yol = ThisWorkbook.Path
conn.Open "Provider=microsoft.ace.oledb.12.0;data source=" & yol & "\Temp1.xlsx;extended properties=""excel 12.0;hdr=yes"";"
rs.Open "Select [Stok Adı],[Temel Mik.],[Tutarı (KDV Dahil)] from [Temp1$a1:F" & Rows.Count & "]", conn, 1, 1
If rs.RecordCount > 0 Then Sheets("veri").Range("A2").CopyFromRecordset rs
rs.Close: conn.Close

MsgBox "Aktarma yapıldı."
End Sub
 
Sütun başlıklarında kullanılan nokta sorun yaratmaktadır.

Aşağıdaki şekilde bu sorunu aşabilirsiniz.

[Temel Mik#]
 
Vallahi bilgi güçtür ne diyeyim. Çok teşekkür ederim.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst