Transpose multiple cells to new rows

[Chesus]

I am relatively new to VBA so this may be something simple. I have an export from a contact database that has multiple email addresses per entry/row. I need to be able to check each row to see if there is a second email address. If there is, I would like to transpose the cell with the 2nd email along with the cell containing the salutation to a new row (with the salutation going into the same column and the 2nd email address going into the main email column). For example: Row 2 only has an entry in A2 (Salutation) & B2 (Main Email). This would be skipped. Row 3 has entries in A3, B3, & C3 (Alternate Email). A3 & C3 would then be transposed to A4 & B4.


Any help/direction would be greatly appreciated! Thank you in advance.

 

[Luke M]

Here's a small macro that might be able to do what you want.

[pre]

Sub ReorderCells()
Dim xRow As Integer
Dim i As Integer

Application.ScreenUpdating = False

'Find last row
xRow = Range("A65536").End(xlUp).Row
For i = xRow To 2 Step -1
If Cells(i, "C") <> "" Then
'Insert Row
Rows(i + 1).Insert Shift:=xlDown
'Transfer data
Cells(i + 1, 1) = Cells(i, "A")
Cells(i + 1, 2) = Cells(i, "C")
'Clear old cell
Cells(i, "C").ClearContents
End If
Next

Application.ScreenUpdating = True
End Sub

[/pre]

 

[Chesus]

Excellent! Exactly what I was looking for. Thank you very much!