Boş hücreleri x ile doldur Sütun kontrol etme

[arrow3441]

Merhabalar öncelikle Türkiyemizin çok geçmiş olsun yaralılara allahtan şifa vefat edenlere ALLAH'tan rahmet diliyorum. Üstadlar ekteki dosyada B8 başlayarak son satıra kadar ve H5 ile AL5 hücresine kadar kontrol ederek H8 ile AL arasındaki boş hücreleri X ile doldurması .
Şunu yaptım sadece boş hücreleri doldurması yaptım fakat diyelim şubat ayı 28 çekiyor diğer sutunlarıda dolduruyor yardımcı olursanız sevinirim. Alttaki resimdeki gibi

 

[Muzaffer Ali]

Merhaba.

Sub DOLDUR()
    On Error GoTo son:
    Dim SonKolon As Integer
    Dim SonSatir As Long
    With ThisWorkbook.Sheets("Sayfa1")
        SonKolon = .Cells(7, "AM").End(xlToLeft).Column
        SonSatir = .Cells(Rows.Count, "C").End(3).Row
        .Range("H8:" & Cells(SonSatir, SonKolon).Address).SpecialCells(xlCellTypeBlanks).Value = "X"
    End With
    
    Exit Sub
son:
    MsgBox "Boş hücre bulamadım."
End Sub

 

[arrow3441]

Çok teşekkür ederim elinize sağlık sorun çözülmüştür

 

[Muzaffer Ali]

Rica ederim. Kolay gelsin.

 

[yanginci34]

Bir alternatifte benden sadece ax1 hücresinde ay sayısını seçmeniz yeterli

 

[arrow3441]

Teşekkür ederim sizinkisi farklı bir çözüm olmuş

 

[yanginci34]

Teşekkür ederim sizinkisi farklı bir çözüm olmuş

Rica ederim iyi akşamlar.

 

[Mdemir63]

Selamlar
Bu da benden Alternatif
Veri doğrulamadan Ay seçmeniz yeterli

 

[arrow3441]

@Mdemir63 Çok güzel olmuş hocam elinize sağlık sizin yaptıgınız dosyayı kullanıcam

 

[Mdemir63]

Rica Ederim.
İyi çalışmalar

 

[Mdemir63]

Tekrar merhabalar
Eğer Butona basmaya gerek yok diyorsanız.
Aşağıdaki kodu Sayfanın Kod penceresine yapıştırıp Hücreden ay seçerek deneyebilirsiniz

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("C3")) Is Nothing Then Exit Sub
  Application.ScreenUpdating = False
        Dim ws As Worksheet
        Dim r As Long
        Set ws = Sheets("Sayfa2")
        ws.Range("H8:AL1000").ClearContents
        r = ws.Cells(Rows.Count, "B").End(xlUp).Row
                If ws.Range("C3") = "Şubat" Then
                        ws.Range("H8:AI" & r).SpecialCells(xlCellTypeBlanks).Value = "X"
                ElseIf ws.Range("C3") = "Ocak" Or ws.Range("C3") = "Mart" Or ws.Range("C3") = "Mayıs" Or _
                ws.Range("C3") = "Temmuz" Or ws.Range("C3") = "Ağustos" Or ws.Range("C3") = "Ekim" Or _
                ws.Range("C3") = "Aralık" Then
                        ws.Range("H8:AL" & r).SpecialCells(xlCellTypeBlanks).Value = "X"
                ElseIf ws.Range("C3") = "Nisan" Or ws.Range("C3") = "Haziran" Or ws.Range("C3") = "Eylül" Or _
                ws.Range("C3") = "Kasım" Then
                        ws.Range("H8:AK" & r).SpecialCells(xlCellTypeBlanks).Value = "X"
                Else
                    Exit Sub
                End If
    Application.ScreenUpdating = True
End Sub

 

[arrow3441]

Teşekkür ederim hocam butonlu şekilde kullanıcam buda arşivimde bulunsun teşekkürler tekrardan

 

[Mdemir63]

Rica Ederim
İyi çalışmalar