jäger
Yeni Üye
Merhabalar ,Benim sorum, 3 ayri excel dosyasinda bulunan tablolari ayri bir excel dosyasinin bir sayfasinda hepsini nasil gösterebilirim.
yardimlariniz icin simdiden tesekkurler
yardimlariniz icin simdiden tesekkurler
Sub ExcelTurkey()
Dim fso As Object, ac As Workbook, sat&, sut&, son&
Set fso = VBA.CreateObject("Scripting.FileSystemObject")
Application.ScreenUpdating = False
For Each dosya In fso.getfolder(ThisWorkbook.Path).Files
If InStr(1, dosya.Name, "$") = 0 And dosya.Name <> ThisWorkbook.Name Then
Set ac = Workbooks.Open(dosya)
With ac.Sheets(1)
sat = .Cells.SpecialCells(11).Row
sut = .Cells.SpecialCells(11).Column
son = ThisWorkbook.Worksheets(1).Cells(Rows.Count, "A").End(3).Row
.Range(.Cells(1, 1), .Cells(sat, sut)).Copy _
ThisWorkbook.Worksheets(1).Cells(son, "A")
ac.Close False
End With
End If
Next dosya
MsgBox "İşlem Tamamlandı.", vbInformation, "Www.ExcelTurkey.Com"
Application.ScreenUpdating = True
son = Empty: sut = Empty: sat = Empty: Set ac = Nothing: Set fso = Nothing
End Sub
If son > 1 Then son = ThisWorkbook.Worksheets(1).Cells(Rows.Count, "A").End(3).Row + 2
Sub ExcelTurkey()
Dim fso As Object, ac As Workbook, sat&, sut&, son&
Set fso = VBA.CreateObject("Scripting.FileSystemObject")
Application.ScreenUpdating = False
For Each dosya In fso.getfolder(ThisWorkbook.Path).Files
If InStr(1, dosya.Name, "$") = 0 And dosya.Name <> ThisWorkbook.Name Then
Set ac = Workbooks.Open(dosya)
With ac.Sheets(1)
sat = .Cells.SpecialCells(11).Row
sut = .Cells.SpecialCells(11).Column
son = ThisWorkbook.Worksheets(1).Cells(Rows.Count, "A").End(3).Row
If son > 1 Then son = ThisWorkbook.Worksheets(1).Cells(Rows.Count, "A").End(3).Row + 2
.Range(.Cells(1, 1), .Cells(sat, sut)).Copy _
ThisWorkbook.Worksheets(1).Cells(son, "A")
ac.Close False
End With
End If
Next dosya
MsgBox "İşlem Tamamlandı.", vbInformation, "Www.ExcelTurkey.Com"
Application.ScreenUpdating = True
son = Empty: sut = Empty: sat = Empty: Set ac = Nothing: Set fso = Nothing
End Sub