Ampliar macro para que realice lo mismo en 2 hojas a la vez

Solicito asistencia para la posibilidad de que la macro (creada por Dante) que describo a continuación realice lo mismo que ya hace y que tambien repita el mismo proceso a la vez en la Hoja denominada (Base(2)).

Necesito añadir sólo la parte de coincidencias

Rango donde van las coincidencias en Base(2), es Rango DP3:DP19 y los números están en DN3:DN19.

Los datos se ingresan 1 a 1 tal cómo lo indica la macro. Solo debe realizar lo que ya hace y repetirlo al mismo tiempo en ambas hojas.

¿Es posible?. Gracias!

Option Explicit
'
Dim d As Variant, e As Variant, g As Variant
'
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Dim rng As Range
  '
  Set rng = Intersect(Target, Range("B2:B100"))
  If Not rng Is Nothing Then
    d = Range("D5:D14").Value 'Historial
    e = Range("E5:E14").Value 'Coincidencias
    g = Range("G5:G14").Value 'Números
  End If
End Sub
'
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim rng As Range, rng1 As Range, cell As Range
  Dim i As Long, j As Long, fila As Long
  Dim dic As Object
  Set dic = CreateObject("Scripting.Dictionary")
  '
  If Target.CountLarge > 1 Then Exit Sub
  Set rng1 = Range("B2:B100")
  Set rng = Intersect(Target, rng1)
  If Not rng Is Nothing Then
    For Each cell In rng1
      If cell.Value <> "" Then
        dic(cell.Value) = dic(cell.Value) + 1
      End If
    Next
    '
    For i = 1 To UBound(g, 1)
      If g(i, 1) <> "" Then
        If g(i, 1) = Target.Value Then 'aquí ocurrió la coincidencia
          If dic.exists(g(i, 1)) Then
            If dic(g(i, 1)) > 1 Then
              e(i, 1) = e(i, 1) + 1
            End If
          End If
        End If
      End If
      If g(i, 1) <> Range("G" & i + 4).Value Then
        d(i, 1) = g(i, 1)
      End If
    Next
  End If
  Range("D5:D14").Value = d
  Range("E5:E14").Value = e
  d = Range("D5:D14").Value 'Historial
  e = Range("E5:E14").Value
  g = Range("G5:G14").Value
End Sub