Format Sonrası Makro ile Veri Getirmede Hata

[Barfly]

Merhaba arkadaşlar,

Uzun zamandan beri kullandığım makro içeren dosyam format sonrası çalışmamaya başladı. Kodu açtığımda bazı karakterlerin değiştiğini farkedip düzelttim fakat değişen birşey yok. İstediğim kritere uygun dosya bulamadığını söylüyor halbuki tamamı uygun ve daha once getiriyordu. Kodu inceleyip yardımcı olabilirseniz sevinirim.

Dim Klasör As Object
Dim S1 As Worksheet
Dim Alt_Klasör As Object
Dim Alt_Dosya As Object
Dim Dosya As String
Dim Hedef_Dosya As Workbook
Dim Sayfa_Adi As String
Dim Say As Long

Private Sub CommandButton1_Click()
    ONAY = MsgBox("Dosyalardan veri almak istiyor musunuz ?", vbYesNo)
    If ONAY = vbNo Then Exit Sub
    
    Set Klasör = CreateObject("Shell.Application").BrowseForFolder(0, "Lütfen bir klasör seçiniz !", 1)
    If Klasör Is Nothing Then
        MsgBox "Klasör seçimi yapmadiginiz için isleminiz iptal edilmistir !", vbExclamation
        Exit Sub
    End If
    
    Application.ScreenUpdating = False
    
    Set S1 = ThisWorkbook.Sheets("OPERASYON")
    S1.Select
    Range("A2:BA" & Rows.Count).ClearContents
    Say = 0
    
    Liste (Klasör.Items.Item.Path)
    Alt_Liste (Klasör.Items.Item.Path)
    Set Klasör = Nothing
    
    Application.ScreenUpdating = True
    
    If Say = 0 Then
        MsgBox "Sectiginiz klasörde kriterlere uygun veri bulunamamistir.", vbCritical
    Else
        MsgBox "Isleminiz tamamlanmistir.", vbInformation
    End If
End Sub

Private Sub Liste(Yol As String)
    Dosya = Dir(Yol & "\*.xlsm*")
    
    While Dosya <> ""
        DoEvents
        
        If InStr(Dosya, ".xlsm") > 0 Then
            If InStr(Dosya, "VERI.xlsm") = 0 Then
                Set Hedef_Dosya = Workbooks.Open(Yol & "\" & Dosya, False, False)
                If InStr(Sheets(1).Name, "IS EMRI") > 0 Then
                    For X = 1 To Sheets(1).Range("F42")
                        Sayfa_Adi = "IS EMRI (" & X & ")"
                        If Sayfa_Kontrol(Sayfa_Adi) Then
                            With Sheets("IS EMRI (" & X & ")")
                                Satir = S1.Cells(65536, 1).End(3).Row + 1
                                S1.Cells(Satir, 1).Value = .Range("F10").Value
                                S1.Cells(Satir, 2).Value = .Range("F17").Value
                                S1.Cells(Satir, 3).Value = .Range("F23").Value
                                For Y = 4 To 21
                                    S1.Cells(Satir, Y).Value = .Cells(Y + 28, "F").Value
                                Next
                                
                                For Y = 22 To 37
                                    S1.Cells(Satir, Y).Value = .Cells(Y + 38, "F").Value
                                Next
                                
                                Say = Say + 1
                                Application.CutCopyMode = False
                            End With
                        End If
                        On Error GoTo 0
                    Next
                    Hedef_Dosya.Close True
                Else
                    Hedef_Dosya.Close True
                End If
            End If
        End If
        
        Dosya = Dir
    Wend
End Sub
 
Private Sub Alt_Liste(Yol As String)
    Set Alt_Klasör = CreateObject("Scripting.FileSystemObject").GetFolder(Yol).SubFolders
 
    On Error GoTo Devam
 
    For Each Alt_Dosya In Alt_Klasör
    Dosya = Dir(Alt_Dosya.Path & "\*.xlsm*")
        While Dosya <> ""
            DoEvents
            
            If InStr(Dosya, ".xlsm") > 0 Then
                If InStr(Dosya, "VERI.xlsm") = 0 Then
                Set Hedef_Dosya = Workbooks.Open(Alt_Dosya.Path & "\" & Dosya, False, False)
                If InStr(Sheets(1).Name, "IS EMRI") > 0 Then
                    For X = 1 To Sheets(1).Range("F42")
                        Sayfa_Adi = "IS EMRI (" & X & ")"
                        If Sayfa_Kontrol(Sayfa_Adi) Then
                            With Sheets("IS EMRI (" & X & ")")
                                Satir = S1.Cells(65536, 1).End(3).Row + 1
                                S1.Cells(Satir, 1).Value = .Range("F4").Value
                                S1.Cells(Satir, 2).Value = .Range("F10").Value
                                S1.Cells(Satir, 3).Value = .Range("F17").Value
                                S1.Cells(Satir, 4).Value = .Range("F23").Value
                                
                                For Y = 5 To 35
                                    S1.Cells(Satir, Y).Value = .Cells(Y + 25, "F").Value
                                Next
                                
                                For Y = 33 To 54
                                    S1.Cells(Satir, Y).Value = .Cells(Y + 135, "F").Value
                                Next
                                
                                Say = Say + 1
                                Application.CutCopyMode = False
                            End With
                        End If
                    Next
                    Hedef_Dosya.Close True
                Else
                    Hedef_Dosya.Close True
                End If
                End If
            End If
            
            Dosya = Dir
        Wend
    Alt_Liste (Alt_Dosya.Path)
Devam:
    Next
    Set Alt_Klasör = Nothing
End Sub

 

[antonio]

Herhangi bir Excel dosyası açın, Excel Seçeneklerinden güvenlik ayarlarını yeniden Makroları çalıştıracak şekilde değiştirin (makroları aktifleştirin).

 

[Barfly]

Merhaba,

Format sonrası güvenlik ayarlarının tamamını olması gerektiği gibi düzenledim sorun bundan kaynaklanmıyor, makroların tamamı şuan aktif zaten aktif olmasa kod çalışmazdı, çalışıyor fakat kriterlere uygun dosya bulamadım diyor.

Teşekkürler,

 

[Barfly]

Arkadaşlar günaydın,

Bu konuda bana yardımcı olabilecek kimse var mıdır?

Teşekkürler,

 

[Barfly]

Merhaba,

Bu konuda bu site dışında kimseden yardım alabileceğimi sanmıyorum, şuan çok ciddi sıkıntı yaşıyorum değerli hocalarımın yardımlarını bekliyorum.

Saygılarımla,

 

[Barfly]

Sayın Yurttaş Hocam,

Vaktiniz varsa siz bakabilir misiniz daha önce kullandığım da excel 2010, format sonrası da aynı versiyonu kurdum. Nette araştırma yaptım VBA da references kısmı var acaba burada tik atmam gereken bir kısım mı var makro gayet güzel çalışıyor fakat xlsm uzantılı dosyaların hiçbisini bulamıyor.

Saygılarımla,