farklı xls dosyalarındakı farklı sheetlerı tek bır sayfada bırlestırme

[mosmos2009]

merhabalar eklı farklı 2 dosyadakı farklı sheetlerı tek xls dosyasında nasıl bırlestırebılırım yardımlarınızı rıca ederım asagıdakı vb ıle kopyaladıgım zaman sadece sheet1 sayfalarını yazmakta fakat dıger sheetlerı kopyalayıp yazmamaktadır.
----------------------------------

Option Explicit

Sub DOSYALARDAN_VERİ_AL()
Dim K1 As Workbook, K2 As Workbook
Dim K3 As Workbook, S1 As Worksheet
Dim X As Integer, Satır As Integer, Son_Satır As Long
Dim Klasör As Object, Kaynak_Klasör As String, Dosya As String

Set Klasör = CreateObject("Shell.Application").BrowseForFolder(0, "Kaynak dosyaları içeren klasörü seçin", 50, &H0)

If Klasör = "Masaüstü" Or Klasör = "Desktop" Then
Kaynak_Klasör = Environ("UserProfile") & "\Desktop\"
ElseIf Not Klasör Is Nothing Then
Kaynak_Klasör = Klasör.Items.Item.Path
Else
MsgBox "İşleme devam edbilmek için klasör seçimi yapmalısınız !" & Chr(10) & _
"İşleminiz iptal edilmiştir.", vbCritical
Exit Sub
End If

On Error Resume Next

Set K1 = ThisWorkbook
Set K2 = Workbooks.Add(1)
Dosya = Dir(Kaynak_Klasör & "\*.xls")
Satır = 2

Application.ScreenUpdating = False

Do
If Dosya <> "" And Dosya <> K1.Name And InStr(1, Dosya, "Dosya") = 0 Then
DoEvents
Application.DisplayAlerts = False
Set K3 = Workbooks.Open(Kaynak_Klasör & "\" & Dosya, False, False)
Application.DisplayAlerts = True
Set S1 = K3.Sheets(1)

Son_Satır = S1.Cells(Rows.Count, 1).End(3).Row
S1.Range("A2:AA" & Son_Satır).Copy _
K2.Sheets("Sheet1").Range("A" & Satır)
Satır = K2.Sheets("Sheet1").Cells(Rows.Count, 1).End(3).Row + 2


K3.Close True
Dosya = Dir
Else
Dosya = Dir
End If
Loop While Dosya <> ""

K2.Sheets("Sayfa1").Cells.EntireColumn.AutoFit
K2.SaveAs (Kaynak_Klasör & "\Dosya_" & Format(Now, "dd_mm_yyyy_hh_mm_ss"))
K2.Close True

Set K1 = Nothing
Set K2 = Nothing
Set K3 = Nothing

 

[mosmos2009]

arkadaslar yardımcı olacak yokmu ?

 

[mosmos2009]

dostlarım sanırım olmayacak bisey istiyorum ??