Excel VBA Макросы: Прописные буквы.

[alexandr_rus]

Макрос

Sub TRP()
    Range("A1:FH5003").Copy
    Sheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.[A1].PasteSpecial Paste:=xlPasteAll, _
        Operation:=xlNone, SkipBlanks:=False, Transpose:=True
End Sub

[свернуть]

Макрос транспонирует данные на новый лист.
Можно ли преобразовать этот код с возможностью транспонирования данных прописными буквами?

[Администратор]

В экселе нет готового инструмента для этой задачи, нужно делать свой код.

Макрос

Sub TRP()
   
    Dim Arr(), i As Long, j As Long
   
    Range("A1:FH5003").Copy
    Sheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.[A1].PasteSpecial Paste:=xlPasteAll, _
        Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    Arr() = ActiveSheet.UsedRange.Value
    For i = 1 To UBound(Arr, 1)
        For j = 1 To UBound(Arr, 2)
            Arr(i, j) = UCase(Arr(i, j))
        Next j
    Next i
    ActiveSheet.UsedRange.Value = Arr()
   
End Sub

[свернуть]

[alexandr_rus]

Спасибо!