Your sample code appeared to represent a header row in row 1. So I started
in Row 2

Sub ReorientData()
Dim sh As Worksheet, rng As Range
Dim sh1 As Worksheet, cell As Range
Dim rng1 As Range, rng2 As Range
Dim cell1 As Range, i As Long
Set sh = ActiveSheet
' get the range of data using the same as if you clicked on A1,
' then held down the shift key while then hitting the end key and then hitting
' the down arrow key
' change to start in row 1
Set rng = sh.Range(sh.Cells(1, 1), sh.Cells(1, 1).End(xlDown))
' add a worksheet to place the data
Set sh1 = Worksheets.Add(after:=Worksheets(Worksheets.Count) )
' start recording the data in row 1 of the new sheet (change)
i = 1
For Each cell In rng
' find the right most column for this row (cell.row) that contains
' data - same as if you want to IV2 and hit End, then hit the left arrow
Set rng1 = sh.Cells(cell.Row, "IV").End(xlToLeft)
' define a range from the cell in the 3rd column to the cell
' in the leftmost column of that row and loop through them
Set rng2 = sh.Range(cell.Offset(0, 2), rng1)
For Each cell1 In rng2
' record the values in column 1, 2 and one of the
' data columns starting in column 3
sh1.Cells(i, 1) = cell.Value
sh1.Cells(i, 2) = cell.Offset(0, 1)
sh1.Cells(i, 3) = cell1
' increment the row in the destination sheet
i = i + 1
Next cell1
Next cell
End Sub

--
Regards,
Tom Ogilvy




"David Vollmer" wrote:

Tom, you are brilliant - and quick! It appears to work perfectly except the
first row was deleted (on my worksheet the first row had only one account
number, if that makes a difference).

If I could understand your code (some of it I do) that would help me down
the road in case my worksheets are laid out differently.

Thank you so much for your help!!

David


"Tom Ogilvy" wrote:

Sub ReorientData()
Dim sh As Worksheet, rng As Range
Dim sh1 As Worksheet, cell As Range
Dim rng1 As Range, rng2 As Range
Dim cell1 As Range, i As Long
Set sh = ActiveSheet
Set rng = sh.Range(sh.Cells(2, 1), sh.Cells(2, 1).End(xlDown))
Set sh1 = Worksheets.Add(after:=Worksheets(Worksheets.Count) )
i = 2
For Each cell In rng
Set rng1 = sh.Cells(cell.Row, "IV").End(xlToLeft)
Set rng2 = sh.Range(cell.Offset(0, 2), rng1)
For Each cell1 In rng2
sh1.Cells(i, 1) = cell.Value
sh1.Cells(i, 2) = cell.Offset(0, 1)
sh1.Cells(i, 3) = cell1
i = i + 1
Next cell1
Next cell
End Sub

worked for me.

--
Regards,
Tom Ogilvy


"David Vollmer" wrote:

I am needing to convert data from several workbooks so that I can import it
into Access. The worksheets are laid out similar to the following:

CustomerNumber # of Rows to add AccountNumbers
Original sheet

36798 3 158008 301976 897736 897728
37253 0 773751
37320 0 777838
37960 0 3770
38066 0 100216254
38562 1 91383 320978


Completed sheet

36798 3 158008
36798 301976
36798 897736
36798 897728
37253 0 773751
37320 0 777838
37960 0 3770
38066 0 100216254
38562 1 91383
38562 320978

I can do all of this manually using the Insert rows, copy and paste special,
transpose, etc. commands but I will wear out my keyboard and fingers doing as
many records as I have and am going to have.

What I would like is a macro that will read the number of rows that need to
be inserted, copy the applicable account numbers, paste them using the paste
special, transpose, and then copy the customer number down the same number of
rows.

Deleting the "old" account numbers would be nice but I can easily do that by
deleting the columns later.

Some of the customers have 30, 40, 50, or more account numbers and I have
calculated the number of rows to enter in the second column.

Your help is appreciated as I am not very good at programming and learn (and
copy) a lot from searching this and other discussion groups.