# Excel Macro - Multiple Columns Into One

Solved/Closed
-
Mani -
Hello,

I need a macro that combines multiple columns into one, but I'm terrible at creating macros! Essentially what I have is data that is sorted into several columns by month, for several years, all on one worksheet. It looks something like this:

WORKSHEET 1:

year day Jan Feb March
1922 1 32 57 83
1922 2 42 84 93
1922 3 34 39

year day Jan Feb March
1933 1 45 15 85
1933 2 45 49 56
1933 3 66 89

So every column may be a different length from month to month according to the number of days in each month (January has 31 days for example) but every Jan column has the same # of entries as every other Jan column, except for February which alternates because of leap year (29 or 28 days). Now, I need to combine all the entries for each year into one long column for the year, on another worksheet. So it would look like this:

WORKSHEET 2:

1922 1933
32 45
42 45
34 66
57 15
84 49
83 85
93 56
39 89

I have many such worksheets with 100+ years of data and doing this manually sucks. If I can combine all of the data into one column for each year just by selecting the January 1st entry and using a macro, that would really help.

Does this make sense? Any help would be appreciated.

## 4 replies

Posts
1864
Registration date
Sunday June 14, 2009
Status
Contributor
Last seen
August 7, 2021
803
OK I have a macro which takes into account all the possibilites as far as I think . There are three macros. But it is enough if you run the macro "test" which incorrporates the other two.

```sub test()
Dim yr, rng As Range, c As Range, cfind As Range
Dim rng1 As Range, add As String, j As Integer
Worksheets("sheet2").Cells.Clear
unique
On Error Resume Next
With Worksheets("sheet2")
Set rng = Range(.Range("A1"), .Range("A1").End(xlToRight))
For Each c In rng
yr = c.Value
j = c.Column
'msgbox yr
'msgbox j
With Worksheets("sheet1")
Set cfind = .Cells.Find(what:=yr, lookat:=xlWhole)
Set rng1 = Range(cfind.Offset(0, 2), .Cells(cfind.Row, Columns.Count).End(xlToLeft)) 'cfind.End(xlToRight))
rng1.Copy
'msgbox j

Worksheets("sheet2").Cells(Rows.Count, j).End(xlUp).Offset(1, 0).PasteSpecial , Transpose:=True

Do
Set cfind = .Cells.FindNext(cfind)

Set rng1 = Range(cfind.Offset(0, 2), .Cells(cfind.Row, Columns.Count).End(xlToLeft)) 'cfind.End(xlToRight)))
rng1.Copy
'msgbox j
Worksheets("sheet2").Cells(Rows.Count, j).End(xlUp).Offset(1, 0).PasteSpecial , Transpose:=True
Loop
line1:

End With
Next c
End With

remove_blanks

Application.CutCopyMode = False
End Sub```

```Sub unique()
With Worksheets("sheet2")
CopyToRange:=.Range("A1"), unique:=True
Range(.Range("a1"), .Range("a1").End(xlDown)).Copy
.Range("B1").PasteSpecial , Transpose:=True
.Range("a1:B1").EntireColumn.Delete

End With

End Sub```

```Sub remove_blanks()
Dim rng As Range
'Range("A1:C12").Select
With Worksheets("sheet2").UsedRange
Set rng = .SpecialCells(xlCellTypeBlanks)

rng.Delete Shift:=xlUp
End With

End Sub
```

The macro isn't working quite as intended, but I think I can tweak it to make it work.

Thanks for the help!
Posts
1864
Registration date
Sunday June 14, 2009
Status
Contributor
Last seen
August 7, 2021
803
will there be gaps in between
for e.g
1922 34,67, ,56, , ,87
in such cse wht do. gaps will come in the result. is it ok.

for e.g
1922
34
67

56

87
Please send the details for splitting the excel sheet file content into different excel files based on group by column by using excel macro