Bir Makroyu Açık Olan Tüm Çalışma Kitapları İçin Çalıştırmak

[gohanx21]

Arkadaşlar elimde aynı formatta 1000 kadar dosya var. Bu excel dosyalarının Sayfa4 ünde standar bir değişiklik yapmak istiyorum. Bunun için bir makro hazırladım. Makroyu çalıştırınca gerekli düzeltmeyi yapıyor.
Makroyu yeni hazırladığım için diğer dosyalarımda yok. Benim istediğim hazırladığım bu makroyu çalıştırınca o anda açık olan bütün çalışma kitaplarında çalışmasını sağlayabilir miyim.
Yani makronun bulunduğu excel dosyası ile makronun bulunmadığı 50 tane dosyayı birlikte açacam. Bu makroyu çalıştırınca açık olan diğer 50 dosya içinde otomatik çalışmasını nasıl sağlayabilirim.?

 

[Orion1]

Kodda ilavelerle gerekli değişikliği yaparak sonuca ulaşabilirsiniz.

 

[gohanx21]

Kodda ilavelerle gerekli değişikliği yaparak sonuca ulaşabilirsiniz.

Evren bey kullandığım örnek makro şu şekilde

Sub verial()
With Sheets("Sayfa3").QueryTables.Add(Connection:="TEXT;C:\ornek.txt", Destination:=Range("Sayfa3!A1"))
.TextFileCommaDelimiter = True
.Refresh BackgroundQuery:=False
End With
End Sub

Nasıl bir değişiklik yapmam gerekiyor acaba.

 

[Orion1]

Evren bey kullandığım örnek makro şu şekilde

Sub verial()
With Sheets("Sayfa3").QueryTables.Add(Connection:="TEXT;C:\ornek.txt", Destination:=Range("Sayfa3!A1"))
.TextFileCommaDelimiter = True
.Refresh BackgroundQuery:=False
End With
End Sub

Nasıl bir değişiklik yapmam gerekiyor acaba.

Özet tablo konusunu pek bilmiyorum.
Bu konuda size başka arkadaşlar yardımcı olacaktır.

 

[gohanx21]

Bu makro yerine şu şekilde bir makro yapmak mümkün mü acaba?

Text dosyasından veri almak yerine. Direk Tüm dosyaların sayfa3'ün A2 hücresinde bulunan bir metin yerine istediğimiz farkı bir metin ile değiştirebilir miyiz.?

A2 hücresinde farklı metinler olabiliyor. Bu metinler yerine hepsine standart olarak Örneğin "Muharrem KARAKOŞ 202" gibi bir metin ile değiştirme şansımız var mı?

 

[Orion1]

Bu makro yerine şu şekilde bir makro yapmak mümkün mü acaba?

Text dosyasından veri almak yerine. Direk Tüm dosyaların sayfa3'ün A2 hücresinde bulunan bir metin yerine istediğimiz farkı bir metin ile değiştirebilir miyiz.?

A2 hücresinde farklı metinler olabiliyor. Bu metinler yerine hepsine standart olarak Örneğin "Muharrem KARAKOŞ 202" gibi bir metin ile değiştirme şansımız var mı?

Dosyalar hangi klasörde tutuluyor?
Sizin dosyanızın adı ne?
Sayfa3'ün A2 hücresine ne yazılacak?

 

[gohanx21]

Dosyalar hangi klasörde tutuluyor?
Sizin dosyanızın adı ne?
Sayfa3'ün A2 hücresine ne yazılacak?

Dosyaların bulunduğu dizin
C:\Zarat Tespit\Merkez
Makronun Bulunacağı Dosyanın Adı
Örnek.xls
Sayfa3'ün A2 Hücresine
"İlçemize bağlı Çökeksu (3 km) yerleşim yeri 1998 yılında Belediye Meclis Kararı ile Köy statüsünden mahalle statüsüne geçirilmiş, bağlı durumunda bulunan Işıklı (1 km) yerleşkesi de mahalle statüsüne geçirilmiş, ancak tüm iş ve işlemler halen İlçe Jandarma Komutanlığı tarafından yürütülmektedir. "

Metni yazılacak.

Değişikliğin yapılacağı dosyaların Sayfa3'ün A2 hücrelerinde farklı ifadeler olabiliyor. Hepsini bu dediğim standart metin ile değiştirmek istiyorum.
Ek olarak A2 hücresi O2 hücresine kadar birleştirilmiş durumda. Tıklayınca A2 olarak görünüyor.

 

[Orion1]

Aşağıdaki kodu kullanabilirsiniz.
Not:"C:\Zarat Tespit\Merkez" klasörü içindeki bütün excel dosyalarında Sayfa3'te A2 hücreleri değişecektir.
Dosyaların kapalı olması gerekiyor.Kod açıp yazıp kapıyor.
Aşağıdaki kırmızı ile yazan yeri istediğiniz şekilde değiştiriniz.

Sub dosyalar()
dosya = Dir("C:\Zarat Tespit\Merkez\*.xls")
Do While dosya <> ""
    If dosya <> "&#214;rnek.xls" Then
        Workbooks.Open ("C:\Zarat Tespit\Merkez\" & dosya)
        Sheets("Sayfa3").Range("A2").Value = "[B][COLOR="Red"]Buraya &#304;stedi&#287;inizi Yaz&#305;n..!![/COLOR][/B]"
        Workbooks(dosya).Close True
    End If
    dosya = Dir
Loop
MsgBox "&#304;&#351;lem Tamamland&#305;..!!", vbOKOnly + vbInformation, "&#304;&#350;LEM"
End Sub

 

[Orion1]

Açık dosyalar için ise aşağıdaki kodları kullanınız.

Sub acik_dosya()
Dim i As Integer
For i = 1 To Workbooks.Count
    If Workbooks(i).Name <> ThisWorkbook.Name Then
        Workbooks(i).Sheets("Sayfa3").Range("A2").Value = "[B][COLOR="Red"]Buraya &#304;stedi&#287;iniz Yaz&#305;n&#305;z.!![/COLOR][/B]"
    End If
Next i
MsgBox "&#304;&#351;lem Tamamlanm&#305;&#351;t&#305;r..!!", vbOKOnly + vbInformation, Application.UserName
End Sub

 

[gohanx21]

Evren bey çok teşekkürler. Bu kod baya kullanışlı. Eminim herkesin işine yarayacaktır.
Emeğinize sağlık.

 

[Orion1]

Evren bey çok teşekkürler. Bu kod baya kullanışlı. Eminim herkesin işine yarayacaktır.
Emeğinize sağlık.

Rica ederim.
İyi çalışmalar.

 

[muzzymania]

elinize sağlık benim işime çok yaradı fakat bu dosyalarda macro çalıştıktan sonra bu dosyalardaki tüm verileri alt alta koyabilirmiyiz , bu yapılamıyorsa tüm sayfaları tek bir kitapta yazabilirmiyiz.
mesela benim dosyalarımda A:G arasında satır sayısı değişken olmak üzere veriler var bunları alt alta nasıl kayabilirim yardım ederseniz bana inanılmaz bir zaman kazandıracaksınız

 

[muzzymania]

bu konuda bir fikir sahibi yol gösterici bir yöntem söyleyebilirmi gerçekten çok zorlanıyorum veri alanını seçip yeni bir kitap açıp klasördeki tüm dosyalardaki verileri alt alta nasıl koyabilirim