Tüm Sayfaları Tek Sayfaya

Excel VBA açık kodlarını buradan izleyebilir ve paylaşabilirsiniz.

Cevap: Cevap: Tüm Sayfaları Tek Sayfaya

İleti#21)  feraz » 29 May 2018 19:32

okankaradag22 yazdı:Üstad'lar merhaba;
Benim elimde bir kod var.İçinde bulunduğu klasörde yer alan tüm excel dosyaları tek bir sayfada topluyor.
Ancak tüm dosyaların sadece ilk sheetlerini topluyor.
Ben klasör içinde yer alan tüm excel dosyaların tüm sayfalarını tek bir sayfada toplamasını istiyorum.
Yardımlarınızı rica edeirm.

=Elimdeki Kod =

Sub dosyalar()
Dim aktif As Workbook, sh As Worksheet, a As Long
Dim klasor As Object, evn As Object, xls As Object
Set sh = ThisWorkbook.Worksheets("TUMU")
Set evn = CreateObject("scripting.filesystemobject")
Set klasor = evn.getfolder(ThisWorkbook.Path)
For Each xls In klasor.Files
If LCase(Mid(xls.shortname, InStr(1, xls.shortname, ".", 1) + 1)) = "xls" Then
If xls.Name <> "ÖRNEK DOSYA.xls" Then
Workbooks.Open (xls.Path)
Set aktif = ActiveWorkbook
a = aktif.Sheets(1).Range("a65536").End(3).Row
aktif.Sheets(1).Range("a2:l" & a).Copy
sh.Range("a65536").End(3)(2, 1).PasteSpecial xlPasteValues
Application.CutCopyMode = False
aktif.Close False


End If
End If
Next xls
a = Empty
Set sh = Nothing
Set evn = Nothing
Set aktif = Nothing
Set klasor = Nothing
End Sub


Bir ipucu vereyim.
Kod: Tümünü seç
If LCase(Mid(xls.ShortName, InStr(1, xls.ShortName, ".", 1) + 1)) = "xls" Then

yerine
Kod: Tümünü seç
If evn.GetExtensionName(xls) = "xls" Then

yazarsanız daha iyi olur.Ve üstadında dediği gibi yeni başlık ve örnek dosya gerek hedefe ulaşmak için :)
Kullanıcı avatarı
feraz
Site Dostu
 
Kayıt: 19 May 2014 19:36
Konum: Almanya
Meslek: İşçi
Yaş: 39
İleti: 4894
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Aksaray

Önceki

Forum Örnek Kodlar

Online Kullanıcılar

Bu forumu görüntüleyenler: Kayıtlı kullanıcı yok ve 1 misafir

Bumerang - Yazarkafe