Dosya Seçerek Alt Alta Aktarma,

[Utekiner]

Merhaba;

Aynı formatta yaklaşık olarak 12 adet dosyam mevcut.

Satır sayısı 1.000 adet ve Sütun sayısı 20 adetten oluşmaktadır.

Makro yardımı ile Seçtiğim dosyaları yeni bir sayfada alt alta eklemek istiyorum. Makro konusunda yardımcı olabilir misiniz. Teşekkürler.

 

[PLİNT]

Merhaba;

Aynı formatta yaklaşık olarak 12 adet dosyam mevcut.

Merhaba
Ek dosyayı deneyin
Kodlarda verileri alınan sayfa adı "Sayfa1"
Eklenen sayfa adı: "VERİ" Bunları kendi dosyalarınızdakilerle değiştirirsiniz

İndir verial

Dosyayı indir verial

dosya.co

Private Sub CommandButton1_Click()
Dim a, c As Object, fn
Dim i As Long, dosya As Integer
fn = Application.GetOpenFilename(FileFilter:="Excel Dosyaları (*.xls;*.xlsx;*.xlsm),*xls;*.xlsm;*.xlsx")
If fn = False Then Exit Sub

Sheets("VERİ").Select

i = Cells(Rows.Count, "A").End(3).Row + 1
Set a = CreateObject("adodb.connection")
Set c = CreateObject("adodb.recordset")
Application.ScreenUpdating = False
a.Open "provider=microsoft.ace.oledb.12.0;data source=" & fn & ";extended properties=""excel 12.0;hdr=yes;imex=1"""
c.Open "select * from [Sayfa1$];", a, 1, 1
Range("A" & i).CopyFromRecordset c
c.Close: a.Close
Application.ScreenUpdating = True
Set c = Nothing: Set a = Nothing
End Sub

 

[Utekiner]

@PLİNT Teşekkür ederim..