dosya birleştirme

[incsoft]

Arkadaşlar bir önceki soruma dosyaları ekleyip gönderme yapamadığımdan yeniden sormak zorunda kaldım.

2016.xlsx dosyası sabit olan kısım , 2017.xlsx dosyası ise değişken olan kısım arkadaşlar. Amacım 2017.xlsx dosyasında 1.satır haricindeki tüm verileri otomatik olarak 2016.xlsx dosyasının sonuna otomatik olarak eklettirmek. Bunu yapmak için nasıl bir macro ya da komut kullanabiliriz?

Alanlar örnek için olduğundan değişkendir.

Teşekkürler.

 

[halit3]

referanslarda bunlar olmalı

Microsoft ActiveX Data Objects Library (Son Versiyonu)
Microsoft ADO Ext. 2.5 for DDL and Security(Son Versiyonu)


Bu kodu bir dene

Private Sub CommandButton1_Click()

Application.DisplayAlerts = False
Dim Con As Object, rs As Object, Sorgu As String, dosya As String, son As String
Dim Kayıt_Yeri As String, Sayfa_adi As String

Sayfa_adi = "[COLOR="Red"]Sayfa1[/COLOR]"
dosya = "[COLOR="red"]2017.XLSX[/COLOR]"

Kayıt_Yeri = ThisWorkbook.Path & "\" & dosya

Set Con = CreateObject("Adodb.Connection")
Set rs = CreateObject("Adodb.RecordSet")
Con.Open = "Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source=" & Kayıt_Yeri & ";Extended Properties=""Excel 12.0;HDR=yes"""

Sorgu = "Select * from [" & Sayfa_adi & "$] "
rs.Open Sorgu, Con, 1, 1

son = Cells(Rows.Count, 1).End(3).Row + 1

Range("A" & son).CopyFromRecordset rs
rs.Close: Con.Close
Set Con = Nothing: Set rs = Nothing: Sorgu = ""
atla:

Application.DisplayAlerts = True
MsgBox "işlem tamam"
End Sub

 

[incsoft]

Hocam öncelikle çok teşekkür ederim. Bu macro 2017.xlsx dosyasında mı yoksa 2016.xlsx dosyasına mı adapte edilecek? Birde adapte ettimi xlsx formatındaki dosyada hata veriyor ve xlsm olarak kaydetmem istiyor. Bu durumda da raporlama yapmış olduğum diğer programım xlsm dosyasını kabul etmiyor.

 

[halit3]

2016.xlsm dosyasından 2017.xlsx dosyasındaki verileri alır

yani veri alacak ana dosyanın uzantısı xlsm olmalı kodlarda o dosyanın içinde olmalı sonra yukardaki mesajdaki kodu çalıştırın kırmızı renkli dosya isminden verileri almaktadır.