Macro : Copy Multiple Columns into 1 Continuous Column in a New Sheet

Below is a VBA Macro to copy multiple columns of variable length into one continuous column in a new sheet. Hope it helps you reduce the time at your work place.

Sub OneColumnV2()
''''''''''''''''''''''''''''''''''''''''''
'Macro to copy columns of variable length'
'into 1 continous column in a new sheet '
''''''''''''''''''''''''''''''''''''''''''
Dim iLastcol As Long
Dim iLastRow As Long
Dim jLastrow As Long
Dim ColNdx As Long
Dim ws As Worksheet
Dim myRng As Range
Dim ExcludeBlanks As Boolean
Dim mycell As Range

ExcludeBlanks = (MsgBox("Exclude Blanks", vbYesNo) = vbYes)
Set ws = ActiveSheet
iLastcol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
On Error Resume Next

Application.DisplayAlerts = False
Worksheets("Alldata").Delete
Application.DisplayAlerts = True

Sheets.Add.Name = "Alldata"

For ColNdx = 1 To iLastcol

iLastRow = ws.Cells(ws.Rows.Count, ColNdx).End(xlUp).Row

Set myRng = ws.Range(ws.Cells(1, ColNdx), _
ws.Cells(iLastRow, ColNdx))

If ExcludeBlanks Then
For Each mycell In myRng
If mycell.Value <> "" Then
jLastrow = Sheets("Alldata").Cells(Rows.Count, 1) _
.End(xlUp).Row
mycell.Copy
Sheets("Alldata").Cells(jLastrow + 1, 1) _
.PasteSpecial xlPasteValues
End If
Next mycell
Else
myRng.Copy
jLastrow = Sheets("Alldata").Cells(Rows.Count, 1) _
.End(xlUp).Row
mycell.Copy
Sheets("Alldata").Cells(jLastrow + 1, 1) _
.PasteSpecial xlPasteValues
End If
Next

Sheets("Alldata").Rows("1:1").EntireRow.Delete

ws.Activate
End Sub
Below are the steps to be followed to run the macro on the required data.
  1. Copy below mentioned VB Macro code
  2. Open Excel and Press Alt + F11 to open VB Project
  3. On left panel, Right click on "This Workbook" under VBA Project
  4. Go to Insert > Modules
  5. Paste the below copied VB code on the right white panel.
  6. Press Cltr + S to save the workbook
  7. Click on the Macro Button to copy every sheet to new workbook
  8. Enjoy.,

Find Last Blank Value (Space) in Excel Cell

How to find Last Blank Value, which is nothing but Space in a Excel Cell? This might be useful to get the Last word separated in to another column. For Example - You want to get City Name into the another column from the Address mentioned in the First column.

Firstly, Lets start with find the last blank value. Formula would be :

FIND("☃",SUBSTITUTE(A1," ","☃",LEN(A1)-LEN(SUBSTITUTE(A1," ",""))))

You can divide it into 3 parts:

Advance Booking Kalka - Simla (Shimla) Toy Train Railway Tickets

Booking Time (Days) to book Toy Train Railway Ticket from Kalka to Simla (Shimla) & Visa versa are different for different trains which are available on the IRCTC website. 

Normally, All the Trains running have the advance booking time of 60 days. Means you can book a train only 60 days in advance but this does not stand true in case of the Kalka & Simla (Shimla) Toy Train.


Below is the list of all the available Toy Train to travel between Kalka (KLK) to Shimla / Simla (SML) with there advance Booking period mentioned in the last column.