Option Explicit
 
Public Sub Transpose_Test()
 Dim varArt As Variant
 Dim rngInputrange As Range, rngOutputrange As Range
 On Error Resume Next
 Set rngInputrange = Application.InputBox( _
 Prompt:="Eingabebereich mit der Maus markieren.", _
 Title:="Auswahl", Type:=8)
  If Err.Number <> 0 Then Exit Sub
 Set rngOutputrange = Application.InputBox( _
 Prompt:="Oberste linke Zelle des Ausgabebereiches mit der Maus markieren.", _
 Title:="Auswahl", Type:=8)
  If Err.Number <> 0 Then Exit Sub
 On Error GoTo Err_Exit
 Do
  varArt = Application.InputBox(Prompt:="Art auswählen" & vbLf & vbLf & _
  "0 = Normales transponieren" & vbLf & _
  "1 = Zeilen und Spalten spiegeln" & vbLf & _
  "2 = Zeilen und Spalten spiegeln und transponieren", _
  Title:="Auswahl", Default:=0, Type:=1)
   If VarType(varArt) = vbBoolean And varArt = False Then Exit Sub
   If Fix(varArt) = varArt Then If varArt >= 0 And varArt <= 3 Then Exit Do
  MsgBox Prompt:="Nur die Zahlen 0 / 1 / 2 zulässig.", _
  Buttons:=vbExclamation, Title:="Hinweis"
 Loop
 Call Transpose_special(rngInputrange, rngOutputrange, CByte(varArt))
 Err_Exit:
End Sub
 
Private Sub Transpose_special(ByVal rngInputrange As Range, _
 ByVal rngOutputrange As Range, _
 ByVal bytArt As Byte)
 Dim varArray() As Variant, lngRow As Long, intColumn As Integer
 On Error GoTo Err_Exit
 Select Case bytArt
  Case 0
   If rngOutputrange.Column + rngInputrange.Rows.Count - 1 <= 256 Then
    varArray = Application.WorksheetFunction.Transpose(rngInputrange)
    rngInputrange.Clear
    Range(rngOutputrange.Cells(1, 1), Cells(rngOutputrange.Row + _
    rngInputrange.Columns.Count - 1, rngOutputrange.Column + _
    rngInputrange.Rows.Count - 1)) = varArray
   Else
    Err.Raise Number:=vbObjectError + 1, Description:="Das passt nicht rein."
   End If
  Case 1
   If rngOutputrange.Row + rngInputrange.Rows.Count - 1 <= 256 Then
    ReDim varArray(1 To rngInputrange.Rows.Count, _
    1 To rngInputrange.Columns.Count)
    For intColumn = 1 To rngInputrange.Columns.Count
     For lngRow = 1 To rngInputrange.Rows.Count
      varArray(lngRow, intColumn) = rngInputrange.Cells( _
      rngInputrange.Rows.Count - lngRow + 1, _
      rngInputrange.Columns.Count - intColumn + 1)
     Next
    Next
    rngInputrange.Clear
    Range(rngOutputrange.Cells(1, 1), Cells(rngOutputrange.Row + _
    rngInputrange.Rows.Count - 1, rngOutputrange.Column + _
    rngInputrange.Columns.Count - 1)) = varArray
   Else
    Err.Raise Number:=vbObjectError + 2, Description:="Das passt nicht rein."
   End If
  Case 2
   If rngOutputrange.Column + rngInputrange.Rows.Count - 1 <= 256 Then
    ReDim varArray(1 To rngInputrange.Columns.Count, _
    1 To rngInputrange.Rows.Count)
    For intColumn = 1 To rngInputrange.Columns.Count
     For lngRow = 1 To rngInputrange.Rows.Count
      varArray(intColumn, lngRow) = _
      rngInputrange.Cells(rngInputrange.Rows.Count - _
      lngRow + 1, rngInputrange.Columns.Count - intColumn + 1)
     Next
    Next
    rngInputrange.Clear
    Range(rngOutputrange.Cells(1, 1), Cells(rngOutputrange.Row + _
    rngInputrange.Columns.Count - 1, rngOutputrange.Column + _
    rngInputrange.Rows.Count - 1)) = varArray
   Else
    Err.Raise Number:=vbObjectError + 3, Description:="Das passt nicht rein."
   End If
 End Select
 Exit Sub
 Err_Exit:
 MsgBox "Fehler " & CStr(Err.Number) & vbLf & vbLf & _
 Err.Description, 16, "Fehler"
End Sub