<WARNING! WARNING!> The following code will cause programmers pain <WARNING! WARNING!>

Right guys, I'm new to VBA but I've done enough programming to know the following example of hard coding is an abomination and I should infact face the firing squad!

I know I need a for or a do while type loop but I have no idea how to implement it as I will require the loop variable to form part of the cell reference (active cell offset is not an option).

So here it is, brace yourselves (please to hunt me down )

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''MY VERY POOR CODE'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''


Sheets("Headcount Summary").Select 'Go to first test cell
Range("A37").Select 'Cell to test for 1 or 0
TestState = ActiveCell.Value


If TestState = 1 Then
Range("B37:BJ37").Select
Selection.Copy
Sheets("Graphing").Select 'Open Graphing Sheet
Range("B37").Select
ActiveSheet.Paste Link:=True 'Paste link to dates Dates

End If
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sheets("Headcount Summary").Select 'Go to next test cell
Range("A38").Select 'Cell to test for 1 or 0
TestState = ActiveCell.Value


If TestState = 1 Then
Range("B38:BJ38").Select
Selection.Copy
Sheets("Graphing").Select 'Open Graphing Sheet
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste Link:=True 'Paste link to dates Dates

End If
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
TRUNCATED (Big section removed - pattern fairly obvious)

Sheets("Headcount Summary").Select 'Go to next test cell
Range("A57").Select 'Cell to test for 1 or 0
TestState = ActiveCell.Value


If TestState = 1 Then
Range("B57:BJ57").Select
Selection.Copy
Sheets("Graphing").Select 'Open Graphing Sheet
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste Link:=True 'Paste link to dates Dates

End If
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sheets("Headcount Summary").Select 'Go to next test cell
Range("A58").Select 'Cell to test for 1 or 0
TestState = ActiveCell.Value


If TestState = 1 Then
Range("B58:BJ58").Select
Selection.Copy
Sheets("Graphing").Select 'Open Graphing Sheet
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste Link:=True 'Paste link to dates Dates

End If

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''END OF MY VERY POOR CODE '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Seriously guys, sorry about that.

Basically what this code does is go down a coulnm in sheet "Headcount Summary" between (A37 and A58 to be more precise) and looks for 1's. When it finds a "1" it copies the cells on that row between columns B and BJ. It then goes to another worksheet "Graphing" and pastes them. Before the row is pasted the active cell is incremented so that the data doesnt overwrite any previously pasted data.

Basically I reckon the code will be of the format of the following pseudo code and VBA Hybrid:

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''BETTER CODE'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
dim i as integer

do

Sheets("Headcount Summary").Select 'Go to next test cell
Range(column A, row i).Select 'Cell to test for 1 or 0
TestState = ActiveCell.Value


If TestState = 1 Then
Range("Bi:BJi").Select
Selection.Copy
Sheets("Graphing").Select 'Open Graphing Sheet
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste Link:=True 'Paste link to dates Dates

i = i + 1

while i<59

I would really appreciate it if someone could show me how to do this in VBA. Thank you, hope you aren't in too much pain!