T3938_Matrix Transpose Rows Format Skills

https://excel-egy.com/forum/t3938
---------------------------------

Sub Matrix_Transpose_Rows_Format_Skills()
    Dim a, b, ws As Worksheet, c As Range, r As Range, i As Long, j As Long, k As Long, x As Long

    Set ws = ThisWorkbook.Worksheets("Report")
    a = ws.Range("A1").CurrentRegion.Value
    ReDim b(1 To UBound(a, 1) * 11, 1 To 6)
    j = 1

    For i = 2 To UBound(a, 1)
        For k = 5 To UBound(a, 2)
            For x = 1 To 4
                b(j, x) = a(i, x)
            Next x

            b(j, 5) = a(1, k)
            b(j, 6) = a(i, k)
            j = j + 1
        Next k
    Next i

    Application.ScreenUpdating = False
        With ws.Range("S1")
            .CurrentRegion.Clear
            .Resize(, UBound(b, 2)).Value = Array("الحساب", "المندوب", "السنة", "النوع", "الشهر", "القيمة")
            .Offset(1).Resize(UBound(b, 1), UBound(b, 2)).Value = b

            With .CurrentRegion
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
                .Font.Size = 13
                .Font.Name = "Arial"
                .Rows(1).Font.Bold = True
                .Rows(1).Interior.Color = vbCyan
                .Columns.AutoFit
            End With
        End With

        For Each c In ws.Range("S2:S" & ws.Cells(Rows.Count, "S").End(xlUp).Row)
            If c.Value = "النسبة" Then
                If r Is Nothing Then Set r = c.Offset(, 5) Else Set r = Union(r, c.Offset(, 5))
            End If
        Next c
        If Not r Is Nothing Then r.NumberFormat = "0%"
    Application.ScreenUpdating = True
End Sub