Klasördeki Workbookların belirli hücrelerine veri yazma

[mukolele]

Öncelikle selamlar.
Bir klasör içindeki 150 farklı dosyada belirli hücrelere belirli veriler yazmak istiyorum. Örneğin X klasörünün içinde bulunan 150 adet çalışma kitabının 1. sayfasındaki A1 hücresine "ABC" yazmak. Yardımcı olabilir misiniz?

 

[Korhan Ayhan]

Merhaba,

Deneyiniz.

Kod içindeki klasör yolunu (My_Folder = "C:\Test\") değiştirmeyi unutmayınız.

Option Explicit

Sub Update_A1_Cells_in_Files_in_Folders()
    Dim Process_Time As Double, My_Folder As String
    Dim My_File As String, Searched_File_Extension As String
    Dim WB As Workbook, SH As Worksheet
    
    Application.ScreenUpdating = False
    
    Process_Time = Timer
    
    My_Folder = "C:\Test\"
    
    Searched_File_Extension = "*.xls*"
    
    My_File = Dir(My_Folder & Searched_File_Extension)
    
    While My_File <> ""
        If My_File <> ThisWorkbook.Name Then
            Set WB = Workbooks.Open(My_Folder & My_File, 1, 0)
            Set SH = WB.Sheets(1)
            SH.Range("A1").Value = "ABC"
            WB.Close True
        End If
        My_File = Dir
    Wend
    
    Application.ScreenUpdating = True
    
    MsgBox "İşleminiz tamamlanmıştır." & vbCrLf & vbCrLf & _
           "İşlem süresi ; " & Format(Timer - Process_Time, "0.00") & " Saniye"
End Sub