Hi,

Am Thu, 10 Oct 2013 00:14:24 -0700 (PDT) schrieb :

Acct. name
123. Joe
Jim

your data in Sheet1. Then the following macro will write your data to
Sheet2:
Sub Test()
Dim i As Long
Dim j As Long
Dim LRow As Long
Dim rngC As Range

With Sheets("Sheet1")
LRow = .Cells(.Rows.Count, 2).End(xlUp).Row
i = 1
For Each rngC In .Range("A2:A" & LRow)
If Len(rngC) 0 Then
i = i + 1
j = 3
Sheets("Sheet2").Cells(i, 1) = rngC
Sheets("Sheet2").Cells(i, 2) = rngC.Offset(, 1)
Else
Sheets("Sheet2").Cells(i, j) = rngC.Offset(, 1)
j = j + 1
End If
Next
End With
End Sub


Regards
Claus B.
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2