Klasör Altında Klasör İçinde Veri Birleştirme

[htsumer]

A Klasörüm Var. A Klaösrü altında B klaösrü ve onun altında bazen klasör bazen de excel dosyaları var.

Tüm klasör altlarındaki Excel dosyalarından sabit sayfa adı olan "Ödeme List" adlı sayfalardaki verileri tek bir excel dosyasında birlerştirmek istiyorum.

Yalnız açılıp içinden veri alınacak dosya altındaki excel dosyalarının "Ödeme List" sayfalarının bazılarında sütunlar gizlenmiş halde.. Ve başka sayfalardan formille veri alıyor. Metin olarak gelmesi gerekiyor

İstediğim bu excel dosyalarının "Ödeme List" sayfasındaki verileri tek bir yere almak.

Tüm excel dosyalarının veri başlangıç satırı B3..
Yan yana sütunların sonu N3
Sayfa satır sayısı bazen 120 bazen de 300. Sınırız aşağıya doğru veri alabilmeli.

Şu kodu denedim ama istediğimi vermedi. Gizli sütunları açıp getirmedi.

Şimdiden teşekkür ederim.

Sub BİRLESTİR()
    If MsgBox("             E M İ N M İ S İ N İ Z ?", vbYesNo, "Dikkat!") = vbNo Then Exit Sub
    Dim NumFound As Long, sno As Long, satir As Long, yurtSutunu As Long, ilkSatir As Long
    Dim dosyaYeri As String, sifre As String
    
    Dim SK As Worksheet, SA As Worksheet
    Dim SK1 As Workbook
    Set SA = Workbooks("AYIR BİRLEŞTİR").Sheets("Liste")
    
    dosyaYeri = Cells(1, 2).Value
    sifre = Cells(1, 6).Value
    sat = 4
    SA.Range("B3:K" & Rows.Count).Clear
    
    
    sDir = Dir$(dosyaYeri & "\*.xls*", vbNormal)
    Application.ScreenUpdating = False:    Application.DisplayAlerts = False
    Application.Calculation = xlCalculationManual
    Do Until LenB(sDir) = 0
        dosya = dosyaYeri & "\" & sDir
        Workbooks.Open dosya, Password:=sifre
        
        'S1 = ActiveSheet.Name
        1
        Set SK1 = Workbooks(sDir)
        Set SK = Workbooks(sDir).Sheets(S1)
        son = SK.Cells(Rows.Count, "B").End(3).Row
        SK.Range("B3:K" & son).Copy SA.Cells(sat, "B")
        sat = (sat - 4) + son + 1
        
        sDir = Dir$
        
        SK1.Close: Set SK1 = Nothing
        Set SK = Nothing
        
    Loop
    Application.ScreenUpdating = True: Application.DisplayAlerts = True
    Application.Calculation = xlCalculationAutomatic
End Sub

 

[Asri]

Bıradaki dosya işini görecektir.

Tüm excel dosyalarındaki belli bir sayfayı tek bir sayfada toplar.
http://asriakdeniz.com/tum-excel-sayfalarini-bir-sayfada-toplama-belirli-bir-sayfa-icin

Bu dosya ise, tüm excel dosyalarındaki tüm sayfaları bir sayfada toplar.
http://asriakdeniz.com/tum-excel-dosyalarini-tek-sayfaya-kopyalama
242

 

[htsumer]

Teşekkür ederim. İnceleyip dönerim..

 

[htsumer]

Sayın asri bey
Çok harika teşekkür ederim.