Заглавные автоматически

[Iskin]

Здравствуйте всем!
Надо что бы в диапазоне h3:h720 все строчные буквы становились в прописные. написал код:

Private Sub Worksheet_Change(ByVal Target As Range)
   If Target.Cells.Count > 1 Then Exit Sub
   If Not Intersect(Target, Range("h3:h720")) Is Nothing Then '-тут ругается
       Target.Value = UCase(Target.Value)
   End If
End Sub

макрос отрабатывает, но и ругается на строку. Помогите исправить.
И второй момент, если мне надо отредактировать два столбца (например еще и O:O), то какой должен быть код?

[Aleksandr H.]

На кого и как ругается? Где файл, скриншот ошибки?

Private Sub Worksheet_Change(ByVal Target As Range)
   If Target.Cells.Count > 1 Then Exit Sub
   If Not Intersect(Target, Range("h3:h720,O:O")) Is Nothing Then 
       Target.Value = UCase(Target.Value)
   End If
End Sub

[Iskin]

Пример во вложение. Может с самой книгой что-то не то...

[Aleksandr H.]

Пример из вложения работает как прописано в макросе.

Private Sub Worksheet_Change(ByVal Target As Range)
   With Range("h3:h720,O:O")
       .Value = UCase(.Value)
   End with
End Sub

[Iskin]

Ругается на .Value = UCase(.Value)
пишет:
Run-time error 13
Type mismatch

[Serge_Bliznykov]

Iskin, если использовать If Target.Cells.Count > 1 Then Exit Sub
тогда в вашем файле никакой ошибки не возникает.
но и множественные ячейки не обрабатываются. (попробуйте скопировать несколько ячеек в столбец H)

попробуйте такой вариант (это я слямзил с StackOverflow):

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim aCell As Range
    Dim onlyThese As Range   ' collection of ranges that, if changed, trigger some action
    Dim cellsToUse As Range  ' cells that are both in "Target" and in "onlyThese"

    On Error GoTo Whoa

    Application.EnableEvents = False

    Set onlyThese = Range("h3:h720") ' in this instance, but could be anything - even a union of ranges
    Set cellsToUse = Intersect(onlyThese, Target)
    If cellsToUse Is Nothing Then GoTo Letscontinue

    ' loop over cells that were changed, and of interest:
    For Each aCell In cellsToUse
        If aCell.Value <> "" Then
            aCell.Value = UCase(aCell.Value)
        End If
    Next

Letscontinue:
    Application.EnableEvents = True
    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume Letscontinue
End Sub

[Iskin]

Не чего не понял про If Target.Cells.Count > 1 Then Exit Sub
Но ваш вариант отработал как надо
Всем спасибо и с наступающим НГ!

[Aleksandr H.]

Сообщение от Iskin

Ругается на .Value = UCase(.Value)
пишет:
Run-time error 13
Type mismatch

Да, косяк не тестированый. Пользуйтесь советом Serge