Option Explicit

Sub jjj()
    Dim arr(), arrStr() As String
    Dim r As Long, r_n As Long, c As Long, c_n As Long, l As Long
    
    Const sCITY As String = "Новгород"
    
    If StrComp(TypeName(Selection), "Range", vbTextCompare) <> 0 Then End
    
    With Selection
        If .Cells.CountLarge > 1 Then
            arr = .Value
        Else
            ReDim arr(1 To 1, 1 To 1)
            arr(1, 1) = .Value
        End If
        
        r_n = UBound(arr, 1)
        c_n = UBound(arr, 2)
        
        For r = 1 To r_n
            For c = 1 To c_n
                arrStr = Split(arr(r, c))
                For l = 0 To UBound(arrStr, 1) - 1
                    If StrComp(arrStr(l), sCITY, vbTextCompare) = 0 Then
                        arrStr(l) = "[" & arrStr(l)
                        arrStr(l + 1) = arrStr(l + 1) & "]"
                        Exit For
                    End If
                Next l
                arr(r, c) = Join(arrStr)
            Next c
        Next r
        
        With .Parent.Parent
            .Sheets.Add After:=.Sheets(.Sheets.Count)
            
            With .Sheets(.Sheets.Count)
                .Cells(1, 1).Resize(r_n, c_n).Value = arr
            End With
        End With
    End With
End Sub