Option Explicit 
Private Sub CommandButton1_Click() 
    Dim Source$, Destination$, MyPos!, MyEndStr!, MySht$ 
    Dim ChkSht1$, ChkSht2$ 
    Dim SR$, SC$, ER$, EC$, i!, j! 
     
     'Check that Source is valid
    On Error Resume Next 
    Source = Range(RefEdit1).AddressLocal 
    If Err <> 0 Then 
        MsgBox "You have entered an invalid starting range.", vbCritical, "Input Error" 
        SendKeys "{tab}" 
        Exit Sub 
    End If 
    On Error GoTo 0 
     
     'Check that Destination is valid
    On Error Resume Next 
    Destination = Range(RefEdit2).AddressLocal 
    If Err <> 0 Then 
        MsgBox "You have entered an invalid destination range.", vbCritical, "Input Error" 
        SendKeys "{tab}{tab}" 
        Exit Sub 
    End If 
    On Error GoTo 0 
     
     'Check source is greater than one cell
    MyPos = InStr(Source, ":") 
    If MyPos = 0 Then 
        MsgBox "You must select more than one cell for the Source Range.", vbCritical, "Input Error" 
        SendKeys "{tab}" 
        Exit Sub 
    End If 
     
     'Check destination is not greater than one cell
    If InStr(Destination, ":") > 0 Then 
        MsgBox "You must select only one cell for the Destination.", vbCritical, "Input Error" 
        SendKeys "{tab}{tab}" 
        Exit Sub 
    End If 
     
     'Get Source sheet name if Destination on a different sheet
    ChkSht1 = Left(RefEdit1, InStr(RefEdit1, "!")) 
    ChkSht2 = Left(RefEdit2, InStr(RefEdit2, "!")) 
    MySht = "" 
    If ChkSht1 <> ChkSht2 Then MySht = ChkSht1 
     
     'Get Row and Column numbers for start and end of Source
    MyEndStr = Len(Source) - MyPos 
    SR = Range(Left(Source, MyPos - 1)).Row() 
    SC = Range(Left(Source, MyPos - 1)).Column() 
    ER = Range(Right(Source, MyEndStr)).Row() 
    EC = Range(Right(Source, MyEndStr)).Column() 
     
     'Write formulae into new transposed location
    For j = 0 To (ER - SR) 
        For i = 0 To (EC - SC) 
            Range(RefEdit2).Offset(i, j).FormulaR1C1 = "=" & MySht & "R" & SR + j & "C" & SC + i 
        Next 
    Next 
     
    Unload UserForm1 
     
End Sub 
 
 '//////////////////////////////////////////////////////////////////////////////////////////////////////////
 'Place this routine in your Personal.xls file standard module
Sub ShowTrans() 
    UserForm1.Show 
End Sub 
 '//////////////////////////////////////////////////////////////////////////////////////////////////////////