Loop Required to Transpose Data from Columns to Rows

	    Field-1    Field-2   Field-3
Part-1	(cellA1)	 (B1)	(C1)
Part-2	(A2)	     (B2)	(C2)
Part-3	(A3)	     (B3)	(C3)

ColA         B        C
Part-1	Field-1	Value
Part-1	Field-2	Value
Part-2	Field-1	Value
Part-2	Field-2	Value
Part-2	Field-3	Value

A	B	C
1	1	Value
1	2	Value
2	1	Value
2	2	Value
2	3	Value

For i = 1 to limit                              <- limit = total # of values in column C
     a = range("A" & i).value             <- get row index
     b = range("B" & i).value             <- get column index
     c = range("C" & i).value             <- get value
     cell(a,b).value = c                     <- put value in cell(a,b)]
Next

Sub test()
Dim Part        As Range
Dim FieldList   As Range
Dim FieldNames  As Range
Dim FieldName   As Range

Application.ScreenUpdating = False
    Columns("A:A").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("E1" _
        ), Unique:=True
    Columns("B:B").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("F1" _
        ), Unique:=True
    Range("F2", [f65536].End(xlUp)).Copy
    Range("F1").PasteSpecial , , , True
    Range("F2", [f65536].End(xlUp)).ClearContents
Set FieldList = Range("F1", [iv1].End(xlToLeft))
    For Each Part In Range("E2", [e65536].End(xlUp))
        With Range("A1:C" & [a65536].End(xlUp).Row)
            .AutoFilter field:=1, Criteria1:=Part
            Set FieldNames = .Offset(1, 1).Resize(.Rows.Count - 1, 1).SpecialCells(xlCellTypeVisible)
            For Each FieldName In FieldNames
                x = Application.WorksheetFunction.Match(FieldName, FieldList, 0)
                Part.Offset(, x) = FieldName.Offset(, 1).Value
            Next FieldName
            .AutoFilter
        End With
    Next Part
Application.ScreenUpdating = True
End Sub

Sub TransposePartNums()
Dim R As Range
Dim dCurValue As Double
Dim sCurPart As String, sCurName As String
Dim vRowPartNum As Variant, vColName As Variant
Dim wsFr As Worksheet, wsTo As Worksheet

'-- Set 'From' & 'To' sheets --
Set wsFr = Sheets("Sheet1")
Set wsTo = Sheets("Sheet2")

'-- Clear 'To' sheet data --
wsTo.UsedRange.ClearContents

For Each R In wsFr.Range("A2:A" & wsFr.Cells(Rows.Count, "A").End(xlUp).Row)
    sCurPart = R.Text
    sCurName = R.Offset(0, 1).Text
    dCurValue = Val(R.Offset(0, 2).Value)
    vRowPartNum = "*"
    On Error Resume Next
    vRowPartNum = WorksheetFunction.Match(sCurPart, wsTo.Columns("A"), 0)
    On Error GoTo 0
    If IsNumeric(vRowPartNum) = False Then
        vRowPartNum = wsTo.Cells(Rows.Count, "A").End(xlUp).Row + 1
        wsTo.Cells(vRowPartNum, "A").Value = sCurPart
    End If
    On Error Resume Next
    vColName = "*"
    vColName = WorksheetFunction.Match(sCurName, wsTo.Rows(1), 0)
    On Error GoTo 0
    If IsNumeric(vColName) = False Then
        vColName = wsTo.Cells(1, Columns.Count).End(xlToLeft).Column + 1
        wsTo.Cells(1, vColName).Value = sCurName
    End If
    wsTo.Cells(vRowPartNum, vColName).Value = dCurValue
Next R

End Sub