[Yardım]  Dosya içerisindeki excel belgeleri tek excel yapma

VBA Makrolar ile ilgili sormak istedikleriniz, yapmak istedikleriniz hakkında yardım alabileceğiniz bölümdür.

Dosya içerisindeki excel belgeleri tek excel yapma

İleti#1)  ben28 » 16 May 2019 08:57

Merhaba,
Gözüken kod sadece " xls " belgelerinde oluyor 65000 Satırlık. Bu kodu " xlsx " olarak düzenleyebilirmiyiz.
2013 üzeri excel belgesinden işlem yapıyorum. Uyumsuzluk oluyor.

Yardımlarınız için şimdiden teşekkür ederim.

Kod: Tümünü seç
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("a9:l" & a).Copy
                    sh.Range("a65536").End(3)(2, 1).PasteSpecial xlPasteValues
                    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
Kullanıcı avatarı
ben28
Siteye Alışmış
 
Kayıt: 17 Ekm 2014 10:18
Meslek: veri analiz
Yaş: 33
İleti: 265
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İstanbul / Ataşehir

Cevap: Dosya içerisindeki excel belgeleri tek excel yapma

İleti#2)  Ali ÖZ » 16 May 2019 09:15

Kod: Tümünü seç
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)) = "xlsx" Then
            If xls.Name <> "ÖRNEK DOSYA.xlsx" Then
                Workbooks.Open (xls.Path)
                    Set aktif = ActiveWorkbook
                    a = aktif.Sheets(1).Range("A1048576").End(3).Row
                    aktif.Sheets(1).Range("a9:l" & a).Copy
                    sh.Range("A1048576").End(3)(2, 1).PasteSpecial xlPasteValues
                    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
Allah bize yeter, O ne güzel vekildir.
حَسْبُنَا اللهُ وَنِعْمَ الْوَكِيلُ
Kullanıcı avatarı
Ali ÖZ
Forum Moderatörü
 
Adı Soyadı:Ali ÖZ
Kayıt: 17 Oca 2013 10:16
Konum: SAKARYA
Meslek: Yazılım
Yaş: 37
İleti: 9728
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Adapazarı/SAKARYA


Forum Genel Makro Soruları

Online Kullanıcılar

Bu forumu görüntüleyenler: Bing[Bot], Yandex[Bot] ve 2 misafir

Bumerang - Yazarkafe