How to automatically update cells, on different sheets, which are validated by a list?

Question

I'm trying to update cells which are validated by a list, when an input in the list gets changed (e.g. due to spelling errors).
My list is on a separate worksheet, called 'Category', and the validated cells are spread over multiple sheets.

The code works based on two sheets ('Category' as source sheet and 'Cost January' as validation sheet).
On the Category sheet, the list starts at column B2.
On the Cost sheet, the validated cells are in Column D, cell 3 and downwards. I have a full year worth of cost sheets, so in total 12 sheets, each called 'Cost "month" '.
As the code uses Private Sub Worksheet_Change(ByVal Target As Range) in the first line, the code is placed inside the sheet "Category". Works with the first "Cost January" sheet, but I need it to update all other "Cost" related sheets as well.

Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
Dim count_cells As Integer
Dim new_value As String
Dim old_value As String
Dim rng As Range
For count_cells = 1 To Range("B2").CurrentRegion.Rows.Count - 1
    Set rng = Worksheets("Cost January").Range("D:D")
    If Intersect(Target, Range("B" & count_cells + 2)) Is Nothing Then
    Else
        Application.EnableEvents = False
        new_value = Target.Value
        Application.Undo
        old_value = Target.Value
        Target.Value = new_value
        rng.Replace What:=old_value, Replacement:=new_value
    End If
Next count_cells
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

Each sheet contains the word "Cost" in the sheet name, so I tried a loop to search the workbook for sheets with "cost" in the name, and then set the range to the desired column/row.

This code looked like this:

Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
Dim count_cells As Integer
Dim new_value As String
Dim old_value As String
Dim rng As Range
For count_cells = 1 To Range("B2").CurrentRegion.Rows.Count - 1
    For Each ws In ActiveWorkbook.Worksheets
        If ws.Name Like "Cost" Then
            Set rng = ws.Range("D:D")
            If Intersect(Target, Range("B" & count_cells + 2)) Is Nothing Then
            Else
                Application.EnableEvents = False
                new_value = Target.Value
                Application.Undo
                old_value = Target.Value
                Target.Value = new_value
                rng.Replace What:=old_value, Replacement:=new_value
            End If


    Next ws
Next count_cells
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

I have to go through twelve sheets to a correct a spelling error etc. in my validation list.