Klasördeki dosyalara sabit veri

[cimbom05]

İyi günler,
Kullanmakta olduğum excel dosyaları aynı formatta ve değişik adlarda aynı klasör içinde kayıtlıdır. Bu dosyaların I28 nolu hücresine K8 yazmak istiyorum. Yazılan K8 ifadesi hücrenin biçimlendirmesine uygun olacaktır. Bunu yapabilir miyiz?

 

[ozgretmen]

İnceler misin ?
http://www.excel.web.tr/f14/tum-dosyalar-ayn-anda-degistirmek-t62789.html

 

[cimbom05]

Sayın ozgretmen ilginiz için teşekkür ederim. Konu başlığı açtığım için tüm forum üyelerinden özür dilerim. İstediğim olay verdiğiniz linkte gerçekleşmektedir.

 

[cimbom05]

Sayın ozgretmen aşağıdaki kodda dosya isimleri 1.xls , 2.xls gibi olunca işlem gerçekleşmektedir. Ancak benim bunu kullanacağım yerde doyalar aynı klasörde ve dosya isimleri birbirinden farklı, Örneğin; TA109-9999 ; L08-5555 gb. Ayrıca bu klasörün içinde binlerce dosya mevcut ve bu işlemi klasörün içindeki tüm dosyalara (adı ne olursa olsun) uygulamak istiyorum.
bu dosyalarda bu kodu kullanmak için ne gibi değişiklik yapmam gerekir.
Kod:
Sub BAK()
On Error Resume Next
For i = 1 To 16
Workbooks.Open ThisWorkbook.Path & "/" & i & ".xls"
Next i
Windows("Ana.xls").Activate
Range("A1").Select
yap = InputBox("Değiştirmek İstediğiniz Hücre İsmini giriniz...(A1 , A2 gibi )", "Hücre Giriniz..")
Range(yap).Copy
For i = 1 To 16
Windows(i & ".xls").Activate
Range(yap).PasteSpecial
Next i
Windows("Ana.xls").Activate
For j = 1 To 16
Windows(j & ".xls").Activate
ActiveWorkbook.Save
Windows(j & ".xls").Close
Next j
Windows("Ana.xls").Activate
End Sub

 

[ozgretmen]

Dener misin ?

Sub bak()
On Error Resume Next
D = Dir(ThisWorkbook.Path & "\")
While Not D = ""
      k = k + 1
      Cells(k, "A") = D
      D = Dir
Wend
For i = 1 To [A65536].End(3).Row - 1
Workbooks.Open ThisWorkbook.Path & "/" & Cells(i, "A").Value
Windows("Ana.xls").Activate
Next i
Windows("Ana.xls").Activate
Range("A1").Select
yap = InputBox("Değiştirmek İstediğiniz Hücre İsmini giriniz...(A1 , A2 gibi )", "Hücre Giriniz..")
For i = 1 To [A65536].End(3).Row - 1
Range(yap).Copy
Windows(Cells(i, "A").Value).Activate
Range(yap).PasteSpecial
ActiveWorkbook.Save
Windows("Ana.xls").Activate
Next i
Windows("Ana.xls").Activate
For j = 1 To [A65536].End(3).Row - 1
Windows(Cells(j, "A").Value).Close
Next j
End Sub

 

[cimbom05]

İlginiz için teşekkürler,
kodu dosyaya uyguladım kodun gerçekleştirdiği işlemler,
1- Klasör içindeki dosyaları ana.xls içinde A sütununa sıralıyor.
2- Listede bulunana dosyaları açıyor. Ben değişiklik yapılan hücreyi tanımlayınca değişikliği uyguluyor.
3- Belirtilen değişikliği listenin en sonundaki dosya dışında tüm dosyalara uyguluyor.
4- Değişikliği uyguladığı tüm dosyalar açık kalıyor.
Bu işlemi klasördeki tüm dosyalara uygulaması için ne yapabiliriz? Birde bu değişiklik dosyalara uygulandıktan sonra açıkta dosya kalmasın (bir önceki kodda olduğu gibi)
Her şey için teşekkür ederim.

 

[ozgretmen]

Çalışma kitaplarınızı dosya isimli bir klasör içine koyunuz.Ana.xls kitabı bu klasörün dışında olacak.

Aşağıdaki kodları bu şekilde denr misiniz ?

Sub kopyala()
On Error Resume Next
D = Dir(ThisWorkbook.Path & "\" & "dosya" & "/")
While Not D = ""
      k = k + 1
      Cells(k, "A") = D
      D = Dir
Wend
For i = 1 To [A65536].End(3).Row
Workbooks.Open ThisWorkbook.Path & "\" & "dosya" & "/" & Cells(i, "A").Value
Windows("Ana.xls").Activate
Next i
yap = InputBox("Değiştirmek İstediğiniz Hücre İsmini giriniz...(A1 , A2 gibi )", "Hücre Giriniz..")
For i = 1 To [A65536].End(3).Row
Range(yap).Copy
Windows(Cells(i, "A").Value).Activate
Range(yap).PasteSpecial
ActiveWorkbook.Save
Windows("Ana.xls").Activate
Next i
Windows("Ana.xls").Activate
For j = 1 To [A65536].End(3).Row
Windows(Cells(j, "A").Value).Close
Next j
MsgBox " İşlem Tamamdır.", vbOKOnly, "OOzG"
End Sub

 

[cimbom05]

Evet, bu sefer oldu ozgretmen. Sorunumla uğraştığınız ve vakit ayırdığınız için ve de özellikle acil çözümleriniz için ne kadar teşekkür etsem azdır.

 

[ozgretmen]

Evet, bu sefer oldu ozgretmen. Sorunumla uğraştığınız ve vakit ayırdığınız için ve de özellikle acil çözümleriniz için ne kadar teşekkür etsem azdır.

Rica ederim.
İyi çalışmalar.:mutlu:

 

[desk]

Burda peki
dosya\ali\veli\zeli
dahi içinde ne olursa olsun sadece excel dosyalarını bulup nasıl yazdırabiliriz.
yani bir klasörün içinde 10 tane klasör bu klasörlerin içinde excel dosyaları ve içlerinde yine klasör olup excel dosyaları bulunsa hepsine nasıl yazdırabiliriz.