Contador de rempalzo en una macro

Hola experto tengo dudas...
prove el codigo del contador que me mandaste no remplaza todos porque sera?
me remplaza partes de cada bloque
este codigo ya lo adapte al contador que me enviaste espero que me puedas ayudar
Dim s As Integer
s = 0
fecha1 = InputBox("Fecha que desea sustituir?", "ORIGEN", Now())
If fecha1 = Empty Then Exit Sub 'mejorar con revisión validez fecha
fecha2 = InputBox("Fecha nueva?", "DESTINO", Now())
If fecha2 = Empty Then Exit Sub 'mejorar con revisión fecha
'Le preguntarás al usuario por las fechas a sustituir y la nueva, y
Do While True
On Error GoTo salida
Cells.Find(What:=Format(UCase(Format(fecha1, "MMMM")) & "_" & Format(fecha1, "yyyy") & "_" & Format(fecha1, "dd")), After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
ActiveCell.Replace What:="[MORELOS_" & UCase(Format(fecha1, "MMMM")) & "_" & Format(fecha1, "yyyy") & "_" & Format(fecha1, "dd"), Replacement:="[MORELOS_" & UCase(Format(fecha2, "MMMM")) & "_" & Format(fecha2, "yyyy") & "_" & Format(fecha2, "dd"), LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
s = s + 1
On Error GoTo salida
Cells.Find(What:=Format(UCase(Format(fecha1, "MMMM")) & "_" & Format(fecha1, "yyyy") & "_" & Format(fecha1, "dd")), After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
ActiveCell.Replace What:="[Rep_Subd_Prod_" & UCase(Format(fecha1, "MMMM")) & "_" & Format(fecha1, "yyyy") & "_" & Format(fecha1, "dd"), Replacement:="[Rep_Subd_Prod_" & UCase(Format(fecha2, "MMMM")) & "_" & Format(fecha2, "yyyy") & "_" & Format(fecha2, "dd"), LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
s = s + 1
On Error GoTo salida
Cells.Find(What:=Format(UCase(Format(fecha1, "yyyy")) & "_" & Format(fecha1, "MMMM") & "_" & Format(fecha1, "dd")), After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
ActiveCell.Replace What:="[CAPTURA_" & UCase(Format(fecha1, "yyyy")) & "_" & Format(fecha1, "MMMM") & "_" & Format(fecha1, "dd"), Replacement:="[CAPTURA_" & UCase(Format(fecha2, "yyyy")) & "_" & Format(fecha2, "MMMM") & "_" & Format(fecha2, "dd"), LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
s = s + 1
On Error GoTo salida
Cells.Find(What:=Format(UCase(Format(fecha1, "MMMM")) & "_" & Format(fecha1, "yyyy") & "_" & Format(fecha1, "dd")), After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
ActiveCell.Replace What:="[Rep_Subd_Prod_" & UCase(Format(fecha1, "MMMM")) & "_" & Format(fecha1, "yyyy") & "_" & Format(fecha1, "dd"), Replacement:="[Rep_Subd_Prod_" & UCase(Format(fecha2, "MMMM")) & "_" & Format(fecha2, "yyyy") & "_" & Format(fecha2, "dd"), LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
s = s + 1
On Error GoTo salida
Cells.Find(What:=Format(UCase(Format(fecha1, "MMMM")) & "_" & Format(fecha1, "dd")), After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
ActiveCell.Replace What:="[FAX_CPI_" & UCase(Format(fecha1, "MMMM")) & "_" & Format(fecha1, "dd"), Replacement:="[FAX_CPI_" & UCase(Format(fecha2, "MMMM")) & "_" & Format(fecha2, "dd"), LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
s = s + 1
On Error GoTo salida
Cells.Find(What:=Format(fecha1, "ddmmyy"), After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
ActiveCell.Replace What:="[DIARIO" & Format(fecha1, "ddmmyy"), Replacement:="[DIARIO" & Format(fecha2, "ddmmyy"), LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
s = s + 1
On Error GoTo salida
Cells.Find(What:=Format(fecha1, "ddmmyy"), After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
ActiveCell.Replace What:="[BALANCE " & Format(fecha1, "ddmmyy"), Replacement:="[BALANCE " & Format(fecha2, "ddmmyy"), LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
s = s + 1
Loop
salida:
MsgBox ("se reemplazaron: " & s & " celdas")
End Sub