Home » excel » Excel: Macro needed – 2 columns of data to become 1 column "every other"

Excel: Macro needed – 2 columns of data to become 1 column "every other"

Posted by: admin April 23, 2020 Leave a comment


Hello and first let me say thank you!

I use Excel to capture user requirements and descriptions. I then take that information and clean it up and paste into presentation docs, apply formatting, paste into Powerpoint, etc. It can be 100s of lines in total that this is done for. What I’m looking for is a macro that I can apply to data once it is pasted into Excel. The data will be text, non-numeric

I have a macro that I use to insert a blank row as every other row. I then do everything else manually (macro shown below).

What I’m looking for is a macro that inserts a blank row, then offsets Column 2 by 1 row down. then pastes column 1 into column 2(without copying the blank cells over my already existing data in column 2).

I’ve pasted a link to an image of what I’m looking for. I’ve also tried to show below (numbers are column 1, letters are column 2).

2 columns to 1 column – desired result

1 A
2 B
3 C

Result I want:


My current “Blank Row” Macro:

Sub insertrow()
' insertrow Macro

Application.ScreenUpdating = True
Dim count As Integer
Dim X As Integer

For count = 1 To 300
If ActiveCell.Value <> "" Then
ActiveCell.Offset(1, 0).Select
Range(ActiveCell, ActiveCell.Offset(0, 0)).EntireRow.Insert
ActiveCell.Offset(1, 0).Select
For X = 1 To 1
Next X
ActiveCell.Offset(1, 0).Range("a1").Select
End If
Next count

End Sub
How to&Answers:

The following does what you need without inserting blank rows. It also calculates what the last row is on the sheet that has 2 columns so that you don’t need to hard-code when the loop will end.

The comments should help you understand what is happening each step of the way. You can then modify this to work with your particular workbook. There are a lot of ways you could go about this. I chose to put the pivoted result on a second sheet.

Sub PivotTwoColumnsIntoOne()
    Dim wb As Workbook
    Dim src As Worksheet
    Dim tgt As Worksheet
    Dim rng As Range
    Dim cell As Range
    Dim lastRow As Long
    Dim targetRow As Long

    Set wb = ThisWorkbook
    ' set our source worksheet
    Set src = wb.Sheets("Sheet1")
    ' set our target sheet (where the single column will be)
    Set tgt = wb.Sheets("Sheet2")
    ' get the last row on our target sheet
    lastRow = src.Range("A" & src.Rows.Count).End(xlUp).Row
    ' set the starting point for our target sheet
    targetRow = 1

    Set rng = src.Range("A1:A" & lastRow)

    For Each cell In rng
        With tgt.Range("A" & targetRow)
            ' get the value from the first column
            .Value = cell.Value
            ' get the value from the second column
            .Offset(1).Value = cell.Offset(, 1).Value
            .HorizontalAlignment = xlLeft
        End With
        targetRow = targetRow + 2
    Next cell
End Sub


This should work, but you’ll have to adjust a little for your exact layout and needs.

Sub mergeColumns()
    Dim mergedData As Variant
    ReDim mergedData(1 To 600)
    dataToProcess = Range("A2:B301")
    For i = 1 To 300
        mergedData(i * 2 - 1) = dataToProcess(i, 1)
        mergedData(i * 2) = dataToProcess(i, 2)
    Next i
    Range("B2:B601") = WorksheetFunction.Transpose(mergedData)
End Sub