Combining Multiple Columns into one column without any blank cells

[mdesroc]

I need to be able to combine 3 columns with ranges that may change into one column without any blank cells.

For example, I have columns B, C and D filled with data, but the number of cells in each of those columns will change based on user choices other places in the spreadsheet.

Is it possible to combine the data from B, C, D into Column A automatically and if so how would I go about doing that?

Thank you for any help or advice you can offer.

 

[VoG]

No, the macro that I posted

Sub test()
Dim LR As Long, i As Long
For i = 2 To 4
    LR = Cells(Rows.Count, i).End(xlUp).Row
    Range(Cells(1, i), Cells(LR, i)).Copy Destination:=Cells(Rows.Count, 1).End(xlUp).Offset(1)
Next i
End Sub

 

[mdesroc]

VoG,
When I run it, its only filling in from column B and C

 

[norulen]

Are there blanks in the original data?? i.e. are there any blanks in B, C and D column

 

[VoG]

For me it copied columns B, C and D - the results of my test

Excel Workbook
	A	B	C	D
1		b	c	d
2	b	b	c	d
3	b	b	c	d
4	b	b		d
5	b	b		d
6	b			d
7	c			d
8	c			d
9	c			d
10	d			d
11	d
12	d
13	d
14	d
15	d
16	d
17	d
18	d
19	d
Sheet1

 

[mdesroc]

there arent any blanks in the original data. Is there anything special I have to do to run the macro? I just have been hitting the macro tab and clicking run

 

[VoG]

The sheet of interest must be selected before you run the code.

 

[mdesroc]

Ok, I did that. It definitely only copied column B and C for me

 

[VoG]

Can you post a shot of your sheet, for example using Excel Jeanie How to

 

[norulen]

Try this i am sure it will work

Sub Macro1()
rcB = ActiveSheet.Cells(Rows.Count, "B").End(xlUp).Row
rcC = ActiveSheet.Cells(Rows.Count, "C").End(xlUp).Row
rcD = ActiveSheet.Cells(Rows.Count, "D").End(xlUp).Row
    
    Range("B1", "B" & rcB).Copy
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("C1", "C" & rcC).Copy
    Range("A" & ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("D1", "D" & rcD).Copy
    Range("A" & ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
lr = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
    For r = lr To 2 Step -1
        
        If ActiveSheet.Range("A" & r).Value = "" Then
            Range("A" & r).Delete Shift:=xlUp
            
        End If
  
     Next r
End Sub

 

[norulen]

Hey VOG, Can you have a look at this code and give me some tips to shorten or make it more compact. I know this is not the cleanest of the code but i would appreciate if you can give me some useful tip as i only have working knowledge macros

Try this i am sure it will work

Sub Macro1()
rcB = ActiveSheet.Cells(Rows.Count, "B").End(xlUp).Row
rcC = ActiveSheet.Cells(Rows.Count, "C").End(xlUp).Row
rcD = ActiveSheet.Cells(Rows.Count, "D").End(xlUp).Row
    
    Range("B1", "B" & rcB).Copy
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("C1", "C" & rcC).Copy
    Range("A" & ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("D1", "D" & rcD).Copy
    Range("A" & ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
lr = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
    For r = lr To 2 Step -1
        
        If ActiveSheet.Range("A" & r).Value = "" Then
            Range("A" & r).Delete Shift:=xlUp
            
        End If
  
     Next r
End Sub