Private Sub btn1_Click()
    Application.ScreenUpdating = 0'отключаем обновление экрана
    Application.Calculation = xlCalculationManual'отключаем автопересчет
    r0_ = 4'начальная строка
    r1_ = Range("A" & Rows.Count).End(xlUp).Row'последняя заполненная строка. Аналог в Excel - встаем в ячейку A1048576 и жмем Контрл+СтелкаВверх
    If r1_ >= r0_ 'если последняя строка не меньше первой
        For j = r0_ To r1_'цикл от первой до последней строки
'=========== дальше Ваш код
If Cells(j, 1) <> "" Then'еслиi-я строка первого столбца не пустая
            Txt = LCase(Cells(j, 1))'работаем с ней
            Txt = Replace(Txt, ", , ", "")
            Txt = Replace(Txt, ", , ,", "")
            Txt = Replace(Txt, ", ,", ",")
            Txt = Replace(Txt, ",", ", ")
            Dim Str() As String
            Str = Split(Txt, " ")
            Txt = ""
            For Each s In Str
                L = Left(s, 1)
                If Txt = "" Then
                    Txt = Replace(s, L, UCase(L), 1, 1)
                Else
                    Txt = Txt & " " & Replace(s, L, UCase(L), 1, 1)
                End If
            Next
            Txt = Replace(Txt, "Город", "г.")
            Txt = Replace(Txt, "Улица", "ул.")
            Txt = Replace(Txt, "Литера", "лит.")
            Txt = Replace(Txt, "Помещение", "пом.")
            For i = Len(Txt) To 1 Step -1
                If Mid(Txt, i, 1) Like "[0-9]" Or Mid(Txt, i, 1) = "-" Then
                    L = Mid(Txt, i + 1, 1)
                    a = Mid(Txt, 1, i)
                    b = Replace(Txt, L, UCase(L), i + 1, 1)
                    Txt = a & b
                End If

            Next i
            Cells(j, 11) = Txt' в i-ую строку 11-го столбца вставляем полученное
End If
        Next j' окончание цикла
    End If
    Application.Calculation = xlCalculationAutomatic'включаем автопересчет
    Application.ScreenUpdating = 0'включаем обновление экрана
End Sub