Este fórum está sendo desativado

[GENECI]

Bom dia!

Solicito a sua ajuda conforme o anexo.

Grato.

[Foxtri]

Bom dia.
Veja se era isso:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Row = 10 And Target.Column = 8 Then
If Range("D4") = "" Then Range("D4") = DateSerial(Year(Date), Month(Date), 1): Exit Sub
ThisWorkbook.Names.Add Name:="XDIA", RefersTo:=Day(Range("D4").Value)
ThisWorkbook.Names.Add Name:="XMES", RefersTo:=Month(Date)
ThisWorkbook.Names.Add Name:="XANO", RefersTo:=Year(Date)
If Year(Range("D4")) = Application.Evaluate(ThisWorkbook.Names("XANO").Value) Then
Range("D4") = DateSerial(Application.Evaluate(ThisWorkbook.Names("XANO").Value), _
Application.Evaluate(ThisWorkbook.Names("XMES").Value), _
Application.Evaluate(ThisWorkbook.Names("XDIA").Value) + 1)
Else
ThisWorkbook.Names.Add Name:="XDIA", RefersTo:=1
ThisWorkbook.Names.Add Name:="XMES", RefersTo:=1
ThisWorkbook.Names.Add Name:="XANO", RefersTo:=Year(Date)
Range("D4") = DateSerial(Application.Evaluate(ThisWorkbook.Names("XANO").Value), _
Application.Evaluate(ThisWorkbook.Names("XMES").Value), _
Application.Evaluate(ThisWorkbook.Names("XDIA").Value))
End If
End If
End Sub

[GENECI]

Boa tarde!
Com o office 2016, não funcionou.

Grato.

[Foxtri]

Bom dia.
veja se essa opção resolve a sua necessidade.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Row = 10 And Target.Column = 8 Then
If Range("H10") = "" Then Exit Sub
If Range("D4") = "" Then Range("D4") = DateSerial(Year(Date), Month(Date), 1): Exit Sub
[XFD1] = Day(Range("D4").Value)
[XFD2] = Month(Date)
[XFD3] = Year(Date)
If Year(Range("D4")) = [XFD3] Then
Range("D4") = DateSerial([XFD3], [XFD2], [XFD1] + 1)
Else
ThisWorkbook.Names.Add Name:="XDIA", RefersTo:=1
ThisWorkbook.Names.Add Name:="XMES", RefersTo:=1
ThisWorkbook.Names.Add Name:="XANO", RefersTo:=Year(Date)
[XFD1] = 1
[XFD2] = 1
[XFD3] = Year(Date)
Range("D4") = DateSerial([XFD3], [XFD2], [XFD1])
End If
End If
End Sub

Até
Foxtri

[Foxtri]

Olá
Corrigindo:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Row = 10 And Target.Column = 8 Then
If Range("H10") = "" Then Exit Sub
If Range("D4") = "" Then Range("D4") = DateSerial(Year(Date), Month(Date), 1): Exit Sub
[XFD1] = Day(Range("D4").Value)
[XFD2] = Month(Date)
[XFD3] = Year(Date)
If Year(Range("D4")) = [XFD3] Then
Range("D4") = DateSerial([XFD3], [XFD2], [XFD1] + 1)
Else
[XFD1] = 1
[XFD2] = 1
[XFD3] = Year(Date)
Range("D4") = DateSerial([XFD3], [XFD2], [XFD1])
End If
End If
End Sub

Até
Foxtri

[GENECI]

Boa tarde! Foxtri

Os códigos não funcionaram, até inicia a contagem, porém não há sequência.

Grato.