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 test()
Dim c As Range, i As Long
For Each c In Selection
For i = 1 To Len(c)
If Mid$(c, i, 1) Like "[P, Q, R, S]" Then
c.Characters(Start:=i, Length:=1).Font.Color = -16776961
End If
Next i
For i = 1 To Len(c)
If Mid$(c, i, 1) Like "[I, J, K, L, M, N, O]" Then
c.Characters(Start:=i, Length:=1).Font.Color = RGB(0, 0, 0)
End If
Next i
For i = 1 To Len(c)
If Mid$(c, i, 1) Like "[A, B, C, D]" Then
c.Characters(Start:=i, Length:=1).Font.Color = RGB(30, 144, 225)
End If
Next i
For i = 1 To Len(c)
If Mid$(c, i, 1) Like "[T, U, V, W, X, Y, ]" Then
c.Characters(Start:=i, Length:=1).Font.Color = RGB(0, 128, 128)
End If
Next i
For i = 1 To Len(c)
If Mid$(c, i, 1) Like "[Z, a, b]" Then
c.Characters(Start:=i, Length:=1).Font.Color = RGB(0, 255, 0)
End If
Next i
For i = 1 To Len(c)
If Mid$(c, i, 1) Like "[E, F, G, H]" Then
c.Characters(Start:=i, Length:=1).Font.Color = RGB(0, 0, 0)
End If


Next i
Next c
End Sub