"Greg Wilson" wrote in message ...
The lines where I specify the ranges for Rng1 and Rng2 are
better written as follows. I forgot that you can specify
a subset of the active sheet using SpecialCells. Correct
for word wrap.

Set Rng1 = ActiveSheet.Columns("A").SpecialCells
(xlConstants)
Set Rng2 = ActiveSheet.Columns("C").SpecialCells
(xlConstants)


Regards,
Greg

-----Original Message-----
I did a sloppy copy and paste. Macro Test2 should be:

Sub Test2()
Dim Rng1 As Range, Rng2 As Range, C As Range
Dim i As Integer

Set Rng1 = Intersect(Columns("A"), _
ActiveSheet.Cells.SpecialCells(xlCellTypeConstant s))
Set Rng2 = Intersect(Columns("C"), _
ActiveSheet.Cells.SpecialCells(xlCellTypeConstant s))

For Each C In Rng1
i = i + 1
Cells(i, 4) = C
Next

i = 0
For Each C In Rng2
i = i + 1
Cells(i, 6) = C
Next

Columns("A:C").Delete
End Sub

Regards,
Greg




-----Original Message-----
Try one of the following two options.

'Preserve spacing in Column A option
Sub Test()
Dim Rng1 As Range, Rng2 As Range
Dim C As Range, TempAr() As String
Dim i As Integer

Set Rng1 = Intersect(Columns("A"), _
ActiveSheet.Cells.SpecialCells(xlCellTypeConstan ts))
Set Rng2 = Intersect(Columns("C"), _
ActiveSheet.Cells.SpecialCells(xlCellTypeConstan ts))

For Each C In Rng2
i = i + 1
ReDim Preserve TempAr(i)
TempAr(i) = C.Value
Next
i = 0
For Each C In Rng1
i = i + 1
C.Offset(, 3) = C
C.Offset(, 5) = TempAr(i)
Next

Columns("A:C").Delete
End Sub

'Remove blanks in Columns A and C option
Sub Test2()
Dim Rng1 As Range, Rng2 As Range, C As Range
Dim i As Integer

Set Rng1 = Intersect(Columns("A"),
ActiveSheet.Cells.SpecialCells(xlCellTypeConstan ts))
Set Rng2 = Intersect(Columns("C"),
ActiveSheet.Cells.SpecialCells(xlCellTypeConstan ts))

For Each C In Rng1
i = i + 1
Cells(i, 4) = C
Next

Regards,
Greg
.

.

I want to say thank you to all that posted solutions . You have been very helpful .

Sincerely Mason