Макрос с выделенными ячейками

Sub ds()
With ThisWorkbook
        Dim sTmp As String, i As Long, cl As Range
        Const TagA As String = "<p>"    ''' <p> - теги абзаца
        Const TagB As String = "</p>"    ''' </p> - теги абзаца
        Const TagP As String = "<br />" ''' <br /> - теги перевода строки
               
        
            ''' Загружаем значение в переменную с обрезанием лишних пробелов
            For Each cl In Range("AE2:AE500")
                
                sTmp = Trim(cl)
                ''' следующая ячейка если пусто
                If Len(sTmp) <> 0 Then
                    ''' Выполнение в тексте поиска переносов и замены на теги
                    sTmp = Replace(sTmp, Chr(10), TagP, 1, -1, vbTextCompare)
                    '''Дописываем в начале и в конце теги
                    If Left(sTmp, 3) <> TagA And Right(sTmp, 4) <> TagB Then
                    sTmp = TagA & sTmp & TagB
                    ElseIf Left(sTmp, 3) = TagA And Right(sTmp, 4) <> TagB Then
                       sTmp = sTmp & TagB
                    ElseIf Left(sTmp, 3) <> TagA And Right(sTmp, 4) = TagB Then
                       sTmp = TagA & sTmp
                    End If
                    ''' Возврат конвертированого текста обратно в ячейку
                    Application.EnableEvents = False
                    cl = sTmp
                    Application.EnableEvents = True
               End If
            Next cl
           End With
End Sub