Kapalı dosya. Belli sayfanın belirli bölümlerinin silinmesi.

[Bora K]

Merhabalar

Alt klasörler dahil. Bütün kitaplar taranacak.
Eğer ki bir kitapta "aaa" sayfası var ise

"aaa" sayfasının
B2;D5 aralığındaki
B7;D11 aralığındaki
ve F4 hücresindeki
veriliri silinecek.

Yukarıdaki özelliklere haiz bir kod istemekteyim. Değerli
uzmanlarımızın yardımlarını bekliyorum.
Saygılarımla.

 

[halit3]

Kod:

Dim sayfaadi As String

Sub Dosya_Listele()
sayfaadi = InputBox("Aranan sayfa adını yaz.", "Sayfa adı", "aaa")
If sayfaadi = "" Then
MsgBox "İşlemi iptal ettiniz"
Exit Sub
End If

Set Klasor = CreateObject("shell.application").BrowseForFolder(0, "Kaynak Dosyaları İçeren Klasörü Seçin", 50, &H0)
If Not Klasor Is Nothing Then
Kaynak = Klasor.SELF.Path
If InStr(1, Kaynak, "{") > 0 Then GoTo Atla

Liste (Kaynak)
Set Klasor = Nothing
MsgBox "işlem tamam"
Else
Atla:
MsgBox "Lütfen Kaynak Klasör Seçimini Yapınız !", vbInformation, "DİKKAT"
End If
End Sub

Private Sub Liste(yol As String)
Dim fL As Object, fs As Object, f As Object, r As Long
Set fL = CreateObject("Scripting.FileSystemObject").GetFolder(yol).subfolders
Set fs = CreateObject("Scripting.FileSystemObject").GetFolder(yol).Files
Dim wb As Workbook

For Each dosya In fs
If ThisWorkbook.Name <> dosya.Name Then
Set wb = Workbooks.Open(dosya)
For r = 1 To Sheets.Count
If Sheets(r).Name = sayfaadi Then

Sheets(Sheets(r).Name).Range("B2:D5").ClearContents
Sheets(Sheets(r).Name).Range("B7:D11").ClearContents
Sheets(Sheets(r).Name).Range("F4").ClearContents
wb.Save
End If
Next r
wb.Close False
End If
Next


On Error GoTo sonraki
For Each f In fL
Liste (f.Path)
sonraki:
Next

Set fL = Nothing
End Sub

 

[Bora K]

Her zamanki gibi harikulade.

Halit Hocam ellerinize sağlık.
Saygılarımla.