Kapalı dosyadan veri alma

[ozuberk]

Merhaba,

Aynı klasör içinde birden fazla kapalı Excel kitabından Kasım adlı kitap sayfalarına veri almak istiyorum. Makroyu çalıştırdığımda Kasım adlı kitabın sayfalarında J1 de kapalı olan kitapların ismi yazılı olan sayfalardaki verileri alsın. Alınacak verideki kitabın adı ile sayfanın adı aynı. Veriler değişkenlik gösterebilir. Alınak verilerin başlangıç yeri A3:E aralığında Kasım adlı kitaba kopyalanacak alan A2:E aralığı.

Örneğin: Kasım adlı kitabın Sayfa1 adlı sayfasının J1 hücresinde 01112017, Sayfa2 adlı sayfasının J1 hücresinde 02112017 yazıyor.

Yardımcı olabilecek arkadaşlara şimdiden teşekkür ederim.

 

[askm]

Sub askm_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("01.11.2017")
    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
                    Sayfa_ismi = Mid(aktif.Name, 2, 2) & "." & Mid(aktif.Name, 4, 2) & "." & Mid(aktif.Name, 6, 4)
                    Set sh = ThisWorkbook.Worksheets(Sayfa_ismi)
                    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
                    aktif.Close False
            End If
            End If
        Next xls
    a = Empty
    Set sh = Nothing
    Set evn = Nothing
    Set aktif = Nothing
    Set klasor = Nothing
    MsgBox "Aktarma işlemi tamamlandı...", vbInformation, "ASKM"
End Sub

 

[ozuberk]

Merhaba ilginiz için teşekkür ederim. Kodu çalıştırdığımda hata veriyor ve uyarılar çıkıyor. Daha sonra kod bölümündeki Workbooks.Open (xls.Path) sarı renk ile işaretleniyor.

 

[askm]

Dosyanızın adını xls.Name <> "ÖRNEK DOSYA.xls" kısmına tam yazdınız mı? Uzantı dahil.

 

[ozuberk]

Evet Kasım.xlsm olarak düzelttim.

 

[PLİNT]

Merhaba
Arkadaşlar affınıza sığınarak;
Açık dosya aynı klasör içinde olduğu için gizli (gölge) "Kasım" dosyasını açmaya çalşıyor olabilir.

   If xls.Name <> ThisWorkbook.Name [COLOR="Blue"]And InStr(xls.Name, "~") = 0 [/COLOR]Then

 

[ozuberk]

Merhaba,

Kodu değiştirdiğimde sorun düzeldi. Yardımlarınız için çok teşekkür ederim.
Bende affınıza sığınarak iki sorum olacak;
1) Set sh = ThisWorkbook.Worksheets("01.11.2017") sayfa ismi değişiklik gösterebilir. Örneğin 01.12.2017, 01.01.2018... gibi
2) Kod ikinci defa çalıştığında alt alta yapıştırıyor. Bunun yerine A2 başlangıç olsun mükerrer kayıt yapmasın.