Excel Macro - Multiple Columns Into One [Solved/Closed]

Report
-
 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
1862
Registration date
Sunday June 14, 2009
Status
Contributor
Last seen
July 30, 2015
791
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)
    'msgbox cfind.Address
    Set rng1 = Range(cfind.Offset(0, 2), .Cells(cfind.Row, Columns.Count).End(xlToLeft)) 'cfind.End(xlToRight))
    'msgbox rng1.Address
    rng1.Copy
    add = cfind.Address
    'msgbox cfind.Address
    'msgbox j
     
    Worksheets("sheet2").Cells(Rows.Count, j).End(xlUp).Offset(1, 0).PasteSpecial , Transpose:=True
    
   
    Do
    Set cfind = .Cells.FindNext(cfind)
    If cfind.Address = add Then GoTo line1
     'msgbox cfind.Address
    
    Set rng1 = Range(cfind.Offset(0, 2), .Cells(cfind.Row, Columns.Count).End(xlToLeft)) 'cfind.End(xlToRight)))
    'msgbox rng1.Address
    rng1.Copy
    'msgbox j
    'msgbox rng1.Address
     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")
Sheets("Sheet1").Range("A1:A7").AdvancedFilter Action:=xlFilterCopy, _
        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
1
Thank you

A few words of thanks would be greatly appreciated. Add comment

CCM 2942 users have said thank you to us this month

Thanks for the reply.

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

Thanks for the help!
1
Thank you

A few words of thanks would be greatly appreciated. Add comment

CCM 2942 users have said thank you to us this month

Posts
1862
Registration date
Sunday June 14, 2009
Status
Contributor
Last seen
July 30, 2015
791
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