Soru Sayfa Birleştirme hk

[bulentkars]

Arkadaşlar Merhaba,

Aşağıdaki sayfa birleştirme makrosu bazı bilgisayarlarda çalıştırıldığında bilinmeyen dosya türü hatası veriyor, bunu çözemedik. makroda sorun yok, bazı kullanıcılarda bu hatayı alıyorum, bende kodun başına 'On Error Resume Next yazdım, bu sefer sayfalar birleştikten sonra mevcut verilerin birleştiği çalışma kitabınıda kapatıyor. burada yapmak istediğim 'On Error Resume Next Aktif edip, dosyalar birleştikten sonra ana dosya "Banka Talimat.xls" olan sayfanın AÇIK kalması kapanmamasını istiyorum, Bu konuda yardımcı olabilirseniz sevinirim.

Sub Dosya_320_Bırlestir()

   Application.DisplayAlerts = False
   'On Error Resume Next
    
    
Dim aktif As Workbook, sh As Worksheet, a As Long
Dim klasor As Object, evn As Object, xls As Object
    Set sh = ThisWorkbook.Worksheets("Gecit")
    Set evn = CreateObject("scripting.filesystemobject")
 
    Set klasor = evn.getfolder("C:\TALIMATLAR\TALIMAT\")
        For Each xls In klasor.Files
            If LCase(Mid(xls.shortname, InStr(1, xls.shortname, ".", 1) + 1)) = "xls" Then
            If xls.Name <> "Banka Talimat.xls" Then
                Workbooks.Open (xls.Path)
                    Set aktif = ActiveWorkbook
                    a = aktif.Sheets("320").Range("a65536").End(3).Row
                    aktif.Sheets("320").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
    
    
    
End Sub

 

[Korhan Ayhan]

Bu iki satırı siliniz.

Workbooks.Open (xls.Path)
Set aktif = ActiveWorkbook

Yerine ise aşağıdaki satırı yazıp deneyiniz.

Set aktif = Workbooks.Open (xls.Path)

 

[bulentkars]

Korhan Bey Günaydın,

Çok Çok Teşekkür ederim. oldu elinize sağlık.. koda küçük bir ilave yapmamız mümkün mü acaba. sayfaları birleştirme işlemi bittiğinde msgboxta kaç adet dosya birleştiridğini gösterebilir miyiz acaba? kodun son halini paylaşıyorum.

Sub Dosya_320_Bırlestir()

   Application.DisplayAlerts = False
     On Error Resume Next
    
    
Dim aktif As Workbook, sh As Worksheet, a As Long
Dim klasor As Object, evn As Object, xls As Object
    Set sh = ThisWorkbook.Worksheets("Gecit")
    Set evn = CreateObject("scripting.filesystemobject")
 
    Set klasor = evn.getfolder("C:\TALIMATLAR\TALIMAT\")
        For Each xls In klasor.Files
            If LCase(Mid(xls.shortname, InStr(1, xls.shortname, ".", 1) + 1)) = "xls" Then
            If xls.Name <> "Banka Talimat.xls" Then
            
              
                Set aktif = Workbooks.Open(xls.Path)
                    
                    
                    
                    a = aktif.Sheets("320").Range("a65536").End(3).Row
                    aktif.Sheets("320").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
    
    
    
End Sub

 

[Korhan Ayhan]

Bu satırın altına;

Set aktif = Workbooks.Open(xls.Path)

Aşağıdaki satırı ekleyiniz.

Say = Say + 1

Mesaj içinde en sona aşağıdaki satırı ekleyebilirsiniz.

MsgBox Say & " adet dosya birleştirilmiştir.", VbInformation

 

[bulentkars]

Korhan bey,

çok teşekkür ederim. emeğinize sağlık..