klasördeki excel dosyalarını birleştirme

[zehfeysal]

asağıdaki kodlarla kaynak adlı klasördeki excel dosyalarımı birlestiriyorum Kaynaktaki excel dosyalarımın sayfa adları Sheet1 olursa birleştiriyor
değişik isim olursa birlestirmiyor kodda nasıl bir değişiklik yapabiliriz excellerin içindeki sayfa ismin ne olursa olsun birlestirsin birlestirsin
tesekkurler

Sub birleştir()
Dim dosya As String, sonsat1 As Long, sonsat2 As Long
Dim sh As Worksheet
Range("B2:T" & Rows.Count).UnMerge
Range("B2:T" & Rows.Count).Clear
Application.ScreenUpdating = False
sonsat1 = Cells(Rows.Count, "B").End(xlUp).Row + 1
dosya = Dir(ThisWorkbook.Path & "\Kaynak\*.xls")
Do While dosya <> ""
Application.DisplayAlerts = False
If Workbooks.Open(ThisWorkbook.Path & "\Kaynak\" & dosya).ReadOnly = True Then
Workbooks(dosya).Close True
End If
Application.DisplayAlerts = True
Set sh = Sheets("Sheet1")
sonsat2 = sh.Cells(Rows.Count, "B").End(xlUp).Row
ThisWorkbook.Activate
sh.Range("B1:T" & sonsat2).Copy
Range("B" & sonsat1).PasteSpecial xlPasteValuesAndNumberFormats
Application.CutCopyMode = False
Workbooks(dosya).Close False
sonsat1 = Cells(Rows.Count, "B").End(xlUp).Row + 1
Set sh = Nothing
dosya = Dir
Loop
Application.ScreenUpdating = True
MsgBox "Veriler aktarıldı." & vbLf & "evrengizlen@hotmail.com"
End Sub

 

[EmrExcel16]

Merhaba ,
Şu satırı Set sh = Sheets("Sheet1") bu şekilde değiştirip dener misiniz set sh = Activesheet
Not : Birden fazla sayfa var ise ve birleştirilmesini istediğiniz sayfa dosya açıldığı anda aktif değilse doğru çalışmayacaktır, zaten sayfa sayısı birden fazla ise sayfa adresi vermeden zor gibi.

 

[zehfeysal]

ilginize tesekkurler ;şimdi oldu sağolun

 

[EmrExcel16]

Rica ederim, iyi çalışmalar.

 

[Korhan Ayhan]

EK olarak Set sh = Sheets(1) şeklinde yazabilirsiniz.

1 değeri sayfanın index numarasıdır.

 

[zehfeysal]

korhan bey sizin gönderdiğiniz kodda çalıştı tesekkurler sağolun