Tüm açılan kitaplara istediğim hücreye formul yapıştırma

[kardelen79]

Arkadaşlar bu makro ile dosyada bulunan tüm kitapları açıp kaydedip kapatıyor 370 tane felan var bu kitaplardan hepside aynı ama bu kitapları çoğalttığım 1 hücresinde formul eksik yazılmış hepsine tek tek açıp kopyala yapıştır yapıyorum ve bu kitaplara bazen değişiklik yapıyorum herseferinde kitapları açıp kaydediyorum bu formul kitapları açınca benim istediğim formulü yapıştırıp istediğim hücreye ondan sonra kaydedip kapatabilir mi ? örneğin Her kitaba J5 HÜCRESİNE =(J5+P11+O8-Q11)-(J11+K11) bu formulü eklemek istiyorum

Sub Test2()
Application.ScreenUpdating = False
Dim Dosya As Object
Application.DisplayAlerts = False
For Each Dosya In CreateObject("Scripting.FileSystemObject").GetFolder(ThisWorkbook.Path & "\BİROL OYAK").Files
If Dosya.Type = "Microsoft Excel Çalışma Sayfası" And Not Dosya.Name = ThisWorkbook.Name Then
Workbooks.Open(Dosya.Path).Close True

End If
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

 

[tahsinanarat]

Sn. @kardelen79 j5 hücresine yazacağınız formül, aynı hücreye başvuruyor, formülünüz doğrumu?

 

[tahsinanarat]

Formül yazılacak hücreyi kontrol ederek aşağıdaki kodu kullanabilirsiniz. Bu kod evvelce bu siteden temin edilen bir koddur.
Not: kapalı olan dosyaların aktif sayfasındaki hücreye ekler.

Option Explicit
Sub Klasördeki_Dosyalara_Formül_Uygula()
    Dim Klasör As Object
    Set Klasör = CreateObject("Shell.Application").BrowseForFolder(0, "Lütfen bir klasör seçiniz !", 1)
    [A2:B65536].ClearContents
    Liste (Klasör.Items.Item.Path)
    Liste (Klasör.Items.Item.Path)
    Set Klasör = Nothing
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

Private Sub Liste(Yol As String)
    Dim Dosya As String, Hedef_Dosya As Workbook
    On Error Resume Next
    Dosya = Dir(Yol & "\*.xls*")
   
    While Dosya <> ""
        Application.ScreenUpdating = False
        DoEvents
        Set Hedef_Dosya = Workbooks.Open(Yol & "\" & Dosya, False, False)
        Range("J6").Formula = "=(J5+P11+O8-Q11)-(J11+K11)"
        Hedef_Dosya.Close True
        Dosya = Dir
        Application.ScreenUpdating = True
    Wend
End Sub

 

[kardelen79]

yukarıdaki formulün içine entegre etsek

 

[kardelen79]

Sn. @kardelen79 j5 hücresine yazacağınız formül, aynı hücreye başvuruyor, formülünüz doğrumu?

evet bütün kitaplar aynı sadece kitapların j5 hücresine yenilik yapacagım şu an ben 370 kitabı açıp o formulü yazıp kapatıyorum o da saatler sürüyor
benim paylaştığım makro ise tüm sayfaları açıp kaydedere kapatıyor benim istegim açtıktan sonra o istediğim hücreye formulü ekleyip kaydedip kapatması

 

[kardelen79]

konum biraz gerilerde kaldı bana da çok lazım yardım cı olabilir misiniz

 

[tahsinanarat]

Ben kapalı olan 370 dosyanın J5 hücresine formül gireceksiniz sanarak arşivimde bulunan o kodları verdim, formülü bütün dosyalarına girince işin hallolacak sanmıştım, ben halen sizin ne istediğinizi tam olarak anlamış değilim. Bende mevcut kodları kendime uyarlayarak işlerimi görmeye çalışıyorum. Kod yazmayı bende bilmiyorum.

 

[kardelen79]

Ben kapalı olan 370 dosyanın J5 hücresine formül gireceksiniz sanarak arşivimde bulunan o kodları verdim, formülü bütün dosyalarına girince işin hallolacak sanmıştım, ben halen sizin ne istediğinizi tam olarak anlamış değilim. Bende mevcut kodları kendime uyarlayarak işlerimi görmeye çalışıyorum. Kod yazmayı bende bilmiyorum.

istediğim tamda (kapalı 370 dosyayı acıp formulü yükleyip kaydedip kapatacak şu an bu yukarıdaki kod açıp kapatıyor ) bu yukarıdaki koda entegre etsek olacak ben denedim sizin kodları ama bende beceremedim bende kot bilmiyorum

 

[kardelen79]

Arkadaşlar makro ne kadar zor bilemiyorum ama ben bilmediğim için bana çok zor.malesef arkadaşlar 370 kitap var bu 370 tane kitaba tam 3 defa sayfalara kopyala yapıştır .yaptım bu benim iki günüme mal oldu varmı dır makro ile bir kolayı diye 2 konu açtım ama kaldı öle canınız sağolsun

 

[kardelen79]

bir hücreyi toplamasını unutmuşum şimdi başladım 370 sayfayı açıp o hücreleri düzeltmeye