вроде как часть переноса получилось сделать но во второй строке не удаляется часть текста, перенесенная на 3 строку

Sub SplitAddress()
   Dim sAddress As String
   Dim lCommaPos As Long
   Dim lSpacePos As Long
   Dim lThirdPos As Long
   With ActiveSheet
       sAddress = .Range("A3") ' получили значеие переменной адрес
       If Len(sAddress) > 25 Then 'если адрес длиннее 25 символов
           If Len(.Range("A3") > 0) Then 'если адрес длиннее 0
               'lCommaPos = InStr(1, sAddress, ",", vbBinaryCompare)
               lSpacePos = InStrRev(Left$(sAddress, 25), " ")
               If lSpacePos > 0 Then
                   .Range("M3").Value = Left(sAddress, lSpacePos)
                   sAddress = Mid(sAddress, lSpacePos + 1)
                       If Len(sAddress) > 55 Then
                           If Len(sAddress) > 0 Then
                               lThirdPos = InStrRev(Left$(sAddress, 55), " ")
                                   If lThirdPos > 0 Then
                                       .Range("I4").Value = Left(sAddress, lThirdPos)
                                       .Range("I5").Value = Mid(sAddress, lThirdPos + 1)
                                   
                           End If
                       End If
                       
                   End If
                   .Range("I4").Value = sAddress
               End If
           End If
       Else
           .Range("M3").Value = sAddress
       End If
   End With
End Sub