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:

1

A

2

B

3

C

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
Else
ActiveCell.Offset(1, 0).Range("a1").Select
End If
Next count
End Sub
```

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
```

### Answer：

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
```

Tags: excelexcel