Boa tarde!!

Considerando que a data está na coluna C

Sub AleVBA_20407()
'Eu não baixei seu arquivo
Dim cell As Range
Dim lr As Long
lr = Cells(ActiveSheet.Rows.Count, 3).End(xlUp).Row
    For Each cell In Range("C2:C" & lr)
            If CDate(cell.Value) = Date Then
                cell.EntireRow.Interior.ColorIndex = 6
            Else
                cell.EntireRow.Interior.ColorIndex = xlNone
            End If
    Next
End Sub

Att

Vê se atende...

É isto mesmo messiasmbm, muito obrigado , poderia adaptar este código ai nesta planilha que estou enviando ai , eu tentei mas não consegui, se puder me ajudar eu agradeço. é na planilha do DIA DA SEMANA E MES.

A Aba que mencionou, não tem nenhuma data, somente 3 Botões, o que quer que adapte ?

A Aba que mencionou, não tem nenhuma data, somente 3 Botões, o que quer que adapte ?

Mauro Clique no botão Dias da semana na planilha aba dia semana e mes que vai aparecer as datas e os dias da semanas quero que fique que nem a planilha que o outro colega messiasmbm postou , o que não to conseguindo aqui adaptar. Grato

Pasedo, em de trocar as rotinas, preserve a que está utilizando e acrescente a que o Alexandre sugeriu ajustando para o que pretende.
Cole a rotina abaixo em seu módulo :

Sub AleVBA_20407()
    
    Dim cell As Range
    Dim lr As Long
    
    lr = Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row
    
    For Each cell In Range("A1:A" & lr)
            If CDate(cell.Value) = Date Then
                Union(cell, cell.Offset(, 1)).Interior.ColorIndex = 6
            End If
    Next
    
End Sub

E no final da macro "Sub PreecheDias()" antes de End Sub acrescente : Call AleVBA_20407

Excelente!!! deu certinho muito obrigado a todos que ajudaram.

Pasedo, olhando com mais calma seu modelo, em sua rotina para Limpar Tudo, não precisamos de todas aquelas instruções, uma vez que a intenção é limpar tudo mesmo, então troque ela por esta :

Usando "ClearContents" estamos apagando somente o conteúdo das celulas, e "Clear" apagamos tudo, até as formatações.

Sub Limpartudo()
'
' Limpartudo Macro
' limpar tudo
    
    Application.ScreenUpdating = False
    
    Range("A1:B31").Clear
    Range("A1").Select
    
    Application.ScreenUpdating = True
    
End Sub

E na Rotina "PreencheDias", troque por esta, não precisamos utilizar varios "Select" e utilizamos o "With" que utilizamos para referenciar o Range uma única vez :

Sub PreecheDias()

    QtdeDias = Day(Application.WorksheetFunction.EoMonth(Date, 0))
    
    Application.ScreenUpdating = False

    For I = 1 To QtdeDias
        ActiveSheet.Cells(I, 1) = DateAdd("d", I, Date - Day(Date))
        ActiveSheet.Cells(I, 2) = Format(DateAdd("d", I, Date - Day(Date)), "dddd")
    Next I

 With Range("A1:B31")
    
    .Borders(xlDiagonalDown).LineStyle = xlNone
    .Borders(xlDiagonalUp).LineStyle = xlNone
        
        .Borders(xlEdgeLeft).LineStyle = xlContinuous
        .Borders(xlEdgeLeft).Color = -16776961
        .Borders(xlEdgeLeft).TintAndShade = 0
        .Borders(xlEdgeLeft).Weight = xlMedium
        
        .Borders(xlEdgeTop).LineStyle = xlContinuous
        .Borders(xlEdgeTop).Color = -16776961
        .Borders(xlEdgeTop).TintAndShade = 0
        .Borders(xlEdgeTop).Weight = xlMedium
        
        .Borders(xlEdgeBottom).LineStyle = xlContinuous
        .Borders(xlEdgeBottom).Color = -16776961
        .Borders(xlEdgeBottom).TintAndShade = 0
        .Borders(xlEdgeBottom).Weight = xlMedium
        
        .Borders(xlEdgeRight).LineStyle = xlContinuous
        .Borders(xlEdgeRight).Color = -16776961
        .Borders(xlEdgeRight).TintAndShade = 0
        .Borders(xlEdgeRight).Weight = xlMedium
    
    .Borders(xlInsideVertical).LineStyle = xlNone
        
        .Borders(xlInsideHorizontal).LineStyle = xlContinuous
        .Borders(xlInsideHorizontal).Color = -16776961
        .Borders(xlInsideHorizontal).TintAndShade = 0
        .Borders(xlInsideHorizontal).Weight = xlMedium
    
        .Interior.Pattern = xlPatternLinearGradient
        .Interior.Gradient.Degree = 90
        .Interior.Gradient.ColorStops.Clear
        
        .Interior.Gradient.ColorStops.Add(0).ThemeColor = xlThemeColorDark1
        .Interior.Gradient.ColorStops.Add(0).TintAndShade = 0
    
        .Interior.Gradient.ColorStops.Add(1).ThemeColor = xlThemeColorAccent1
        .Interior.Gradient.ColorStops.Add(1).TintAndShade = 0
    End With
   
    Call AleVBA_20407
    
    Application.ScreenUpdating = True
    
End Sub

[]s