Soru Çalışma Kitaplarını Birleştirmek

[bulentkars]

Arkadaşlar Merhaba,

C:\TALIMATLAR\TALIMAT\ Klasörü içerisinde aynı formatta birden fazla uzantısı .xlsm olan çalışma kitaplarım var, bunları alt alta kopyalamak istiyorum, Örneğin igili klasör altındaki 1.xlsm sayfasını açacak 329 sayfasının A2:L arasını alıp kopyala yapıştır yapacak, daha sonra 2.xlsm dosyasını açıp 329 sayfasının aynı aralığı kopyalarak önceki verilerin altına yapıştıracak. bu vesile ile klasörün altındaki xlsm uzantılı dosyaları birleştirmiş olacağım. Yardımcı Olabilirseniz Sevinirim. Şimdiden Teşekkürler

 

[Merhum İdris SERDAR]

.

Buradaki dosyayı kullanabilirsiniz.

https://www.excelgurusu.com/dosya-ve-sayfalarinin-tek-sayfada-birlestirilmesi/

.

 

[bulentkars]

İdris Bey Merhaba,

sayfa halinde istemiyorum ben, tuşa bastığımda sayfaların içinde 329 sayfalarını alt alta kopyalayan bir makro lazım

 

[Merhum İdris SERDAR]

İdris Bey Merhaba,

sayfa halinde istemiyorum ben, tuşa bastığımda sayfaların içinde 329 sayfalarını alt alta kopyalayan bir makro lazım

Merhaba.

Ben bu yazdığınızdan hiç bir şey anlamadım. Yazdığınızı tekrar okur musunuz? Benim verdiğim dosya başta sorduğunuz sorunun tam yanıtıdır.




.

 

[bulentkars]

İdris Bey,

Forumda arama yaptım daha önce yazdığınız aşağıdaki kod tam işime yarıyor, burada sadece sayfa adını belritebilirsek çok güzel olur.
Kodta Klasörü yolu tamam
seçilecek aralık tamam
sadece sayfa adınıda belirtirseniz ona göre ben değişiklik yapacağım. birleştireceğimz dosyalarda 3 sayfa var, aşağıdaki kodun içerisine sayfa adını belirtirseniz sevinirim.

320 sayfası
329 sayfası
grup sayfası

Sub kitapbirlestir()

Dim bkLst As Workbook
Dim mObj As Object, dObj As Object, fObj As Object, eObj As Object
Application.ScreenUpdating = False
Set mObj = CreateObject("Scripting.FileSystemObject")
 
Set dObj = mObj.Getfolder("C:\TALIMATLAR\TALIMAT\") ' Dosya yolunu kendinize uyarlayın.
Set fObj = dObj.Files
For Each eObj In fObj
Set bkLst = Workbooks.Open(eObj)

Range("A2:L" & Range("A65536").End(xlUp).Row).Copy ' "A2" başlangıç hücresini kendi verilerinize göre ayarlayın.

ThisWorkbook.Worksheets(1).Activate
 
Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial
Application.CutCopyMode = False

bkLst.Close

Next

End Sub