Data Transpose

[SriIndia]

Hi,

I am new to vba and wanted some help in writing a vba code.

Could you please help me to write a code for the below example?

Headers
Year A B C D
2011 1 3 5 6
2012 4 5 1 9
2013 2 7 9 4
2014 6 4 3 1
2015 12 2 4 10


To
Item year Value - headers
A 2011 1
A 2012 4
A 2013 2
A 2014 6
A 2015 12
B 2011 3
B 2012 5
B 2013 7
B 2014 4
B 2015 2

I want the results in a new sheet.

Thanks Sri

 

[hemesh]

hello Sri, I am not good in VBA, is it fine with a formula solution

 

[SriIndia]

hello Sri, I am not good in VBA, is it fine with a formula solution

Ok.I wanted a vba cobe . Can you share your formula, that might give me some idea to code. Thanks Hemesh.
__________________________________________________________________

Mod edit : thread moved to appropriate forum !​

 

[vletm]

@SriIndia
Something like this...

 

[Marc L]

Hi !

♪ My way ♫ :​

Sub Demo()
    VA = Sheet1.Cells(1).CurrentRegion.Value
    ReDim VR((UBound(VA) - 1) * (UBound(VA, 2) - 1), 2)
          VR(0, 0) = "Item"
          VR(0, 1) = VA(1, 1)
          VR(0, 2) = "Value"
  For C& = 2 To UBound(VA, 2)
      For R& = 2 To UBound(VA)
                L& = L& + 1
          VR(L, 0) = VA(1, C)
          VR(L, 1) = VA(R, 1)
          VR(L, 2) = VA(R, C)
      Next
  Next
    With Worksheets.Add(, Worksheets(Worksheets.Count))
        .Cells(1).Resize(UBound(VR) + 1, 3).Value = VR
    End With
End Sub

Do you like it ? So thanks to click on bottom right Like !
​

 

[shrivallabha]

You can try this as well:

Public Sub TransposeData()
Dim SourceRng As Range, DestnRange As Range
Set SourceRng = Range("A1").CurrentRegion '// Change this to suit

Application.ScreenUpdating = False

Set DestnRange = Range("H1") '// Change this to suit
DestnRange.CurrentRegion.Offset(1, 0).Delete xlUp
DestnRange.Resize(1, 3).Value = Split("Item,Year,Value", ",")

For i = 1 To SourceRng.Columns.Count - 1
    Set DestnRange = Cells(Rows.Count, DestnRange.Column).End(xlUp).Offset(1, 0)
    DestnRange.Resize(SourceRng.Rows.Count - 1, 1).Value = SourceRng.Cells(1, i + 1).Value
    SourceRng.Columns(1).Offset(1, 0).Copy Cells(DestnRange.Row, DestnRange.Column + 1)
    SourceRng.Columns(i + 1).Offset(1, 0).Copy Cells(DestnRange.Row, DestnRange.Column + 2)
Next

Application.ScreenUpdating = True

End Sub

 

[Marc L]

shrivallabha, same way if I wanna play with cells !

But if you don't mind, better is to free object variables at end :​

Application.ScreenUpdating = True
            Set DestnRange = Nothing
             Set SourceRng = Nothing
End Sub

 

[shrivallabha]

shrivallabha, same way if I wanna play with cells !

But if you don't mind, better is to free object variables at end :​

Application.ScreenUpdating = True
            Set DestnRange = Nothing
             Set SourceRng = Nothing
End Sub

Agree. I sometimes forget while posting snippets.

 

[Marc L]

Often the same for me …
​