Belli Hücrelerdeki Nesneleri silme makro ile

[koboy]

Merhabalar,

Makroyu çalıştırınca tüm nesneleri siliyor.Benim istediğim örnek a:1 s:8 kadar olan kısımdaki
nesneler silisin

Sub farklikaydet()
Yol = ThisWorkbook.Path
ad = [A4] & "_" & [I1]
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Sheets("ANASAYFA").Copy
Sheets("ANASAYFA").DrawingObjects.Delete


If Val(Application.Version) > 11 Then
ActiveWorkbook.SaveAs Filename:=Yol & "\" & ad & ".xls", FileFormat:=xlExcel8
Else
ActiveWorkbook.SaveAs Filename:=Yol & "\" & ad & ".xls"
End If
ActiveWorkbook.Close True
Application.ScreenUpdating = True
End Sub

 

[PLİNT]

Merhaba
Aşağıdaki gibi ek yaparak deneyiniz;

Sub farklikaydet()
Yol = ThisWorkbook.Path
ad = [A4] & "_" & [I1]
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Sheets("ANASAYFA").Copy
[COLOR="Red"]With ActiveWorkbook.Sheets("ANASAYFA")
For Each x In .DrawingObjects
If Not Intersect(x.TopLeftCell, .Range("A1:S8")) Is Nothing Then _
x.Delete
Next
End With[/COLOR]
If Val(Application.Version) > 11 Then
ActiveWorkbook.SaveAs Filename:=Yol & "\" & ad & ".xls", FileFormat:=xlExcel8
Else
ActiveWorkbook.SaveAs Filename:=Yol & "\" & ad & ".xls"
End If
ActiveWorkbook.Close True
Application.ScreenUpdating = True
End Sub