sort headings vertically ....

[RAJESH1960]

I have this data in one sheet with dates in 30-31 date rows and amount in columns. I am coping and pasting each row and column manually in a new sheet to get the desired result. It is taking me hours to complete this. If there is any other easier and faster way to do this, please share.

The count of number of cells in each column varies from date to date and may range up to 300 rows in some cases. I am trying to get the data, in a new worksheet, in such a way that I get the date in one column and the amounts in the adjoining column. The amounts in column A starting from cell A2 to A 12 need to be copied and pasted to column B in a new worksheet. In Column A of the new work sheet it should take the date from cell A1. Again, the amounts in column B starting from B2 to B4 need to be copied and pasted to column B of the new worksheet, below the next empty cell. Here, column B, in the new worksheet, it should take the date from cell B2 below the next empty cell and so on…..

For reference only, I have used the same worksheet for the query.

Query for copy data to next sheet in vertical oder.xlsx
	A	B	C	D	E	F	G
1	01-01-2020	02-01-2020	03-01-2020		Date	Amount
2	12.50	30.00	836.35		01-01-2020	12.50
3	627.90	92.50	548.60		01-01-2020	627.90
4	1,470.00	142.00	313.15		01-01-2020	1,470.00
5	475.80		661.90		01-01-2020	475.80
6	623.65		0.50		01-01-2020	623.65
7	22.50		108.50		01-01-2020	22.50
8	6.00		25,000.00		01-01-2020	6.00
9	12.00				01-01-2020	12.00
10	18.00				01-01-2020	18.00
11					02-01-2020	30.00
12					02-01-2020	92.50
13					02-01-2020	142.00
14					03-01-2020	836.35
15					03-01-2020	548.60
16					03-01-2020	313.15
17					03-01-2020	661.90
18					03-01-2020	0.50
19					03-01-2020	108.50
20					03-01-2020	25,000.00
21	This is the Data				Final Result in new blank worksheet
22
workings

 

[Fluff]

How about

Sub Rajesh()
   Dim Cl As Range
   
   With Sheets("Workings")
      For Each Cl In .Range("A1", .Cells(1, Columns.Count).End(xlToLeft))
         With .Range(Cl.Offset(1), Cl.End(xlDown))
            .Copy Sheets("Sheet2").Range("B" & Rows.Count).End(xlUp).Offset(1)
            Cl.Copy Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(.Count)
         End With
      Next Cl
   End With
End Sub

 

[RAJESH1960]

How about

Sub Rajesh()
   Dim Cl As Range
  
   With Sheets("Workings")
      For Each Cl In .Range("A1", .Cells(1, Columns.Count).End(xlToLeft))
         With .Range(Cl.Offset(1), Cl.End(xlDown))
            .Copy Sheets("Sheet2").Range("B" & Rows.Count).End(xlUp).Offset(1)
            Cl.Copy Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(.Count)
         End With
      Next Cl
   End With
End Sub

Perfect.... Thank You Mr.Genius. This is one of those difficult codes to understand which I would like to understand someday.

 

[Fluff]

Glad to help & thanks for the feedback.