Macro to transpose two columns and add an extra column to a number of fields

[MrPink1986]

Hi there,

I have 67 fields in column A and B beginning in A2 and B2 - I would like to take the first value in A2 and place it in D1 and then the value in B2 and place it in E1. I would like to then add a column with "Diff" in F1. This column should be formatted to display a percentage value and 6 decimal places.

I would then like to loop through the values in A and B and follow this sequence for all 67 fields.
Any ideas on how this may be achieved?

 

[mumps]

Try:

Sub MrPink()
    Application.ScreenUpdating = False
    Range("A2").Resize(67, 2).Copy Range("D1")
    With Range("F1")
        .Value = "Diff"
        .Resize(67, 1).NumberFormat = "0.000000%"
    End With
    Application.ScreenUpdating = True
End Sub

 

[MrPink1986]

Thanks for your reply on this. I now realize I was not clear on the requirement.
I would like to take the first value in A2 and place it in D1 and then the value in B2 and place it in E1 and put the header "Diff" in D1.
Then repeat the process by taking the value in A3 and place it in G1, the value in B3 and place it in H1 and put the header "Diff" in I1.

So I want to transpose the data in columns A and B put in a certain sequence.

Try:

Sub MrPink()
    Application.ScreenUpdating = False
    Range("A2").Resize(67, 2).Copy Range("D1")
    With Range("F1")
        .Value = "Diff"
        .Resize(67, 1).NumberFormat = "0.000000%"
    End With
    Application.ScreenUpdating = True
End Sub

 

[mumps]

Try:

Sub MrPink()
    Application.ScreenUpdating = False
    Dim rng As Range, lCol As Long
    For Each rng In Range("A2:A68")
        lCol = ActiveSheet.UsedRange.Columns.Count + 1
        If lCol < 4 Then lCol = 4
        rng.Resize(1, 2).Copy Cells(1, lCol)
        Cells(1, lCol + 2) = "Diff"
        Cells(2, lCol + 2).NumberFormat = "0.000000%"
    Next rng
    Application.ScreenUpdating = True
End Sub

 

[MrPink1986]

Perfecto - that worked a treat and i now have my data lined up as I need it - thanks alot.

Try:

Sub MrPink()
    Application.ScreenUpdating = False
    Dim rng As Range, lCol As Long
    For Each rng In Range("A2:A68")
        lCol = ActiveSheet.UsedRange.Columns.Count + 1
        If lCol < 4 Then lCol = 4
        rng.Resize(1, 2).Copy Cells(1, lCol)
        Cells(1, lCol + 2) = "Diff"
        Cells(2, lCol + 2).NumberFormat = "0.000000%"
    Next rng
    Application.ScreenUpdating = True
End Sub

 

[mumps]

My pleasure.