Hello Gurus!

Thanks in advance for your help. I'm trying to reformat a spreadsheet so the
data will be easily entered into a database. The basics are taking data in
rows, transposing it to columns like so:

Row1
Row2
Row3
Row4

Column1 Column2 Column3
Row1 Row2 Row3
Row1 Row2 Row4

When I have a sheet with 4 rows, the code gives me an "cannot find cell"
error when looking for the next blank cell in column1. Any Ideas? I'll copy
the code in and indicate the line below.


Sub DeliverableReformat()
'Macro to reformat
Dim Looptimes As Integer
Dim BookObject As Range


'Select All, Copy, Paste Special - transpose
Range("A1:AZ9").Select
Selection.Copy
Range("A10").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone,
SkipBlanks:=False, Transpose:=True

'delete original data
Rows("1:9").Select
Selection.Delete Shift:=xlUp

[A1].Select
'count columns (to determine how many times to loop)
Looptimes = LastColumn - 1
'run to here and then check It's highliting AD1-AD6?

'insert title row
[M1].Value = "HCPS Benchmark Code"
[N1].Value = "Publisher"
[O1].Value = "Imprint"
[P1].Value = "Title"
[Q1].Value = "Copyright Date"
[R1].Value = "Student Edition ISBN"
[S1].Value = "Material ID"
[T1].Value = "Pages"
[U1].Value = "Hyperlink"

'Edit 1st column so only Bmk code remains
Range("A1:A6").ClearContents
Range("A7").Select
Range(Selection, Selection.End(xlDown)).Select

Dim cellobject As Range
For Each cellobject In Selection
cellobject.Value = ExtractBmkCode(cellobject.Value)
Next

'Repeat Looptimes
Dim counter
For counter = 1 To Looptimes
'Copy Bmks
Dim colNum As Integer
Dim eCell As Range

Range("A7").Select
Range(Selection, Selection.End(xlDown)).Select
Dim stdsLength As Integer 'length of column that book info will
need to be filled for'
stdsLength = Selection.Count
Selection.Copy
'find the first blank cell in column M to copy into
colNum = 13
ERROR Set eCell =
Columns(colNum).SpecialCells(xlCellTypeBlanks).Cel ls(1)
eCell.Select
ActiveSheet.Paste

'Distribute book information
Dim Column_range As Integer
'n = Looptimes
Column_range = counter + 1

Range(Cells(1, Column_range), Cells(6, Column_range)).Select
'you must copy for the paste special to work
Selection.Copy
'find the first blank cell in column N to copy into
colNum = 14
Set eCell =
Columns(colNum).SpecialCells(xlCellTypeBlanks).Cel ls(1)
eCell.Select
Dim startrow As Integer
startrow = Selection.Row

'Select copy Range("N2:S2").Select
Range(Cells(startrow, 14), Cells(startrow, 19)).Select
'Cells(startrow, 14).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone,
SkipBlanks:=False, Transpose:=True

' Range("bookpages").Cut
Cells(7, Column_range).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
'Find the first blank cell in column T to copy to
colNum = 20
Set eCell =
Columns(colNum).SpecialCells(xlCellTypeBlanks).Cel ls(1)
eCell.Select
ActiveSheet.Paste

'Copy book info over for all members of the column.
'how long is column M?
Range(Cells(startrow, 14), Cells((startrow + stdsLength - 1),
19)).FillDown
Next 'counter

'delete old columns - this works, but is commented out until I get the loop
working.
Columns("A:L").Select
Selection.Delete Shift:=xlToLeft

'resize columns to even width
Columns("A:I").ColumnWidth = 12