Transpose

Just read your code pike and although you put me to shame (not hard really) I think the header "Blank" is quite important to the scheme as I think columns could be added or taken away, thus making "Blank" an "end of headers" marker, dates now follow.

Hello Guys,

Thanks for the response.

All of the codes worked fine for the given workbook but they are not completely generic.

I have coded it to be generic to any kind of data with any position of the blank column (except last).

But there is just one issue,

The code takes a hell lot of time to execute when inserting a row.

Pike and Col12345, please do help me make this thing a bit quicker.

' Macro3 Macro
'

'
Dim x As Long
Dim col As Long
Dim xr As Long

Application.ScreenUpdating = False
Sheets(1).Select
    Range("A2").Select
    Selection.End(xlToRight).Select
    Selection.End(xlToRight).Select
    Range(Selection, Selection.End(xlToRight)).Select
    x = Selection.Columns.Count
    MsgBox (x)
    
    'title
    
    Rows("1:1").Select
    Selection.Copy
    Sheets(2).Select
    Rows("1:1").Select
    ActiveSheet.Paste
    
    'rows beneath title
    
    Sheets(1).Select
    Range("A2").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets(2).Select
    
    Range("A2").Select
    For col = 1 To x
     'MsgBox (x)
    'Sheets(1).Select
    'Range(Selection, Selection.End(xlToRight)).Select
    'Range(Selection, Selection.End(xlDown)).Select
    'Selection.Copy
    'Sheets(2).Select
    
    ActiveSheet.Paste
    
   Selection.End(xlToLeft).Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Select
    'Range("A15").Select
    'Sheets(1).Select
Next col

'Bring columns down

'First Column
Sheets(1).Select
    Range("A2").Select
    Selection.End(xlToRight).Select
    Selection.End(xlToRight).Select
    Range(Selection, Selection.End(xlDown)).Select
     xr = Selection.Rows.Count
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(2).Select
    Range("A2").Select
    Selection.End(xlToRight).Select
    ActiveCell.Offset(0, 2).Select

    
    'Rest Column
  For col = 1 To x
      ActiveSheet.Paste
  Sheets(1).Select
      ActiveCell.Offset(0, 1).Select
    Range(Selection, Selection.End(xlDown)).Select
    'Application.CutCopyMode = False
    Selection.Copy
    Sheets(2).Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Select
    
    'ActiveSheet.Paste
    
    'Application.CutCopyMode = False
    Next col
    
    'insert new row
    
     Sheets(2).Select
     Range("A1").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

Sheets(1).Select
Range("A2").Select
    Selection.End(xlToRight).Select
    Selection.End(xlToRight).Select
     ActiveCell.Offset(-1, 0).Select
    Selection.Copy
    Sheets(2).Select
    Range("A2").Select
    For col = 1 To xr
    ActiveSheet.Paste
       ActiveCell.Offset(1, 0).Select
       Next
       
       'Repeat for Next years
       For j = 0 To x - 2
       Sheets(1).Select
       ActiveCell.Offset(0, 1).Select
       Selection.Copy
       Sheets(2).Select
       
       For col = 1 To xr
    ActiveSheet.Paste
       ActiveCell.Offset(1, 0).Select
       'ActiveCell.Offset(1, 0).Select
       Next
              Next
           Cells.Select
    Cells.EntireColumn.AutoFit
    Range("A2").Select
              Selection.End(xlToRight).Select
    Selection.End(xlToRight).Select
ActiveCell.Offset(-1, 0).Select
    Selection.ClearContents
    
    ActiveCell.FormulaR1C1 = "Volume"
      ActiveCell.Offset(0, 1).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.ClearContents