Combining Multiple Columns into one column without any blank cells

VoG

Legend
Joined
Jun 19, 2002
Messages
63,651
No, the macro that I posted

Code:
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
 

Some videos you may like

Excel Facts

Pivot Table Drill Down
Double-click any number in a pivot table to create a new report showing all detail rows that make up that number

norulen

Active Member
Joined
Nov 30, 2012
Messages
389
Are there blanks in the original data?? i.e. are there any blanks in B, C and D column
 

VoG

Legend
Joined
Jun 19, 2002
Messages
63,651
For me it copied columns B, C and D - the results of my test

Excel Workbook
ABCD
1bcd
2bbcd
3bbcd
4bbd
5bbd
6bd
7cd
8cd
9cd
10dd
11d
12d
13d
14d
15d
16d
17d
18d
19d
Sheet1
 

mdesroc

New Member
Joined
Dec 8, 2012
Messages
18
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

Legend
Joined
Jun 19, 2002
Messages
63,651
The sheet of interest must be selected before you run the code.
 

mdesroc

New Member
Joined
Dec 8, 2012
Messages
18
Ok, I did that. It definitely only copied column B and C for me
 

norulen

Active Member
Joined
Nov 30, 2012
Messages
389
Try this i am sure it will work
Code:
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

Active Member
Joined
Nov 30, 2012
Messages
389
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
Code:
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
 

Watch MrExcel Video

Forum statistics

Threads
1,096,310
Messages
5,449,608
Members
405,573
Latest member
Diogo Martins

This Week's Hot Topics

Top