Dia da Semana por Extenso no Excel Conforme a Data | Automático ao Digitar

[@CanalSGP]

MACRO PARA COPIAR:
Public Executando As String
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Erro
Dim Linha As Double, LinhaCabecalho As Double
Dim Coluna As Double, i As Double
Dim ColunaData As Double, ColunaDia As Double
Dim LinhaInicial As Double, LinhaFinal As Double
Dim CelInicio As String, CelFim As String
Dim Area As String, Dia As String
Dim Data As Date
Dim TextoArea As Variant
ColunaData = 2 'ALTERAR
ColunaDia = 3 'ALTERAR
LinhaCabecalho = 2 'ALTERAR
Coluna = Target.Column
If Coluna ColunaData Then
Exit Sub
End If
If Executando = Empty Then
Executando = "ok"
Area = Selection.Address
On Error Resume Next
TextoArea = VBA.Split(Area, ":")
On Error Resume Next
CelInicio = TextoArea(0)
On Error Resume Next
CelFim = TextoArea(1)
For i = 1 To VBA.Len(CelInicio)
If IsNumeric(VBA.Mid(CelInicio, i, 1)) Then
LinhaInicial = LinhaInicial & VBA.Mid(CelInicio, i, 1)
End If
Next i
For i = 1 To VBA.Len(CelFim)
If IsNumeric(VBA.Mid(CelFim, i, 1)) Then
LinhaFinal = LinhaFinal & VBA.Mid(CelFim, i, 1)
End If
Next i
If LinhaFinal > 0 Then
Linha = LinhaInicial
With ActiveSheet
Do
If IsDate(.Cells(Linha, ColunaData).Value) = True Then
Data = .Cells(Linha, ColunaData).Value
End If
If Data Empty And Linha > LinhaCabecalho Then
.Cells(Linha, ColunaDia).Value = VBA.UCase(VBA.Format(Data, "dddd"))
Else
.Cells(Linha, ColunaDia).Value = Empty
End If
Linha = Linha + 1
Loop Until Linha = LinhaFinal + 1
End With
Executando = Empty
Exit Sub
End If
Linha = Target.Row
With ActiveSheet
If IsDate(.Cells(Linha, ColunaData).Value) = True Then
Data = .Cells(Linha, ColunaData).Value
End If
If Data Empty And Linha > LinhaCabecalho Then
.Cells(Linha, ColunaDia).Value = VBA.UCase(VBA.Format(Data, "dddd"))
Else
.Cells(Linha, ColunaDia).Value = Empty
End If
End With
Executando = Empty
End If
Exit Sub
Erro:
MsgBox "Erro!", vbCritical, "DIA DA SEMANA"
End Sub