Belli sütun aralığındaki verileri sil ve yerine 0(sıfır) yaz

[ÇAĞRIBEY1]

Değerli Hocalarım,
Bir konuda yardımınıza ihtiyacım var. Yardımını esirgemeyecek olan herkese şimdiden teşekkür ederim.
Sütun sil düğmesine bastığımda önceden F3 hücresinde açılır liste yoluyla seçtiğim sütunu silecek ve yerlerine otomatik olarak 0(sıfır) yazacak kod rica ediyorum sizlerden. Ek açıklama dosyanın içinde mevcuttur.

 

[Orion1]

Dosyanız ektedir.

Sub sut_sil59()
Dim sut As Integer, k As Range, sonsut As Integer, sat As Long
sonsut = Cells(2, Columns.Count).End(xlToLeft).Column
Set k = Range(Cells(2, 1), Cells(2, sonsut)).Find(Range("F3").Value, , xlValues, xlWhole)
If k Is Nothing Then Exit Sub
sat = Cells(Rows.Count, k.Column).End(xlUp).Row
Range(Cells(3, k.Column), Cells(sat, k.Column)).Value = 0
Set k = Nothing
End Sub

 

[ÇAĞRIBEY1]

Dosyanız ektedir.

Sub sut_sil59()
Dim sut As Integer, k As Range, sonsut As Integer, sat As Long
sonsut = Cells(2, Columns.Count).End(xlToLeft).Column
Set k = Range(Cells(2, 1), Cells(2, sonsut)).Find(Range("F3").Value, , xlValues, xlWhole)
If k Is Nothing Then Exit Sub
sat = Cells(Rows.Count, k.Column).End(xlUp).Row
Range(Cells(3, k.Column), Cells(sat, k.Column)).Value = 0
Set k = Nothing
End Sub

Sayın Hocam,
Minnet ve teşekkürlerimi iletiyorum. Elinize ve emeğinize sağlık.