Auto copy-paste range off cells

[dirkx0205]

Hi, I want to copy and paste a range off cells automatically.
Copy all non blank cells from the sheet "calculations" and paste them in a column (BB) on the sheet "count list". Than I want to copy a selection of 35 cells (BB1:BB36) to B1 and transpose them, the next 35 cells (BB37:BB72) should be copied and pasted in the row underneath (B2), and continue doing this untill cell BB1500 is reached.
A part of the code that I've got you can find underneath, it is working but if I want to use it for all the columns I've got the code gets to long and doesn't work anymore.

Does anyone knows a way to narrow down the code??? (With some kind off counter/loop maybe ???)

Thx



Sub list()

'

' list Macro

' Macro recorded 17/03/2011 by user2381
'

'Delete previous data
Sheets("Count list").Select

Range("B1:IV5000").Select

Selection.ClearContents

Range("d4").Select



'Get names from sheet "set up specs"
Range("A1").Select

ActiveCell.FormulaR1C1 = "='Set Up Specs'!R[8]C[1]"

Range("A44").Select

ActiveCell.FormulaR1C1 = "='Set Up Specs'!R[-34]C[1]"

Range("A87").Select

ActiveCell.FormulaR1C1 = "='Set Up Specs'!R[-76]C[1]"



'Copy data from sheet calculations and paste at sheet count list "bb1"
Sheets("Calculations").Select

'auto filter; copy non-blank cells to sheet count list bb1
Selection.AutoFilter Field:=5, Criteria1:="<>"

Range("E3:E1500").Select

Selection.Copy

Sheets("Count list").Select

Range("bb1").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=True, Transpose:=False

'turn off autofilter
Sheets("Calculations").Select

Selection.AutoFilter Field:=5

Sheets("Count list").Select

'Copy - paste 35 cells in b1, next 35 in b2, next 35 in b3, .....(with transpose true)
'Select 35 cells (bb1:bb36) copy paste them and repeat for the next 35 cells and paste them in the next row
Range("bb1:bb36").Select

Selection.Copy

Range("b1").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=True

Range("bb37:bb72").Select

Selection.Copy

Range("b2").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=True, Transpose:=True

Range("bb73:bb108").Select

Selection.Copy

Range("b3").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=True, Transpose:=True

'and so one, and so one .....
'delete contents BB1 (copy data)
Sheets("Count list").Select

Range("BB1:IV2000").Select

Selection.ClearContents



End Sub