Have a range of cell with column headings as weeks In the range of cells I want to look for a number, say 

1 if it finds a 1 then look at a column in said row for a variable, 2 or 4 whatever Now I want to put a triangle (can be copy and paste a cell) in the cell that has the "1" in it then skip over the number of week variable and add another triangle and keep doing this until the end of the range. Then skip down to the next row and do the same, until the end of the range.  

Then change to the next page and do the same thing... through the whole workbook.

I think I have it done, don't know if it's the best way. 

I get a error 91 at the end of the second loop, the first time the second loop ends it goes through the error code.
The second time the second loop ends it errors.

I don't understand it runs through once, but not twice.

```
    Sub Add_Triangles2()

    Dim Rng As Range
    Dim OffNumber As Integer
    Dim SetRange As Range
    Dim OffsetRange As Range
    Dim ws As Worksheet   

    Set SetRange = Sheets("Sheet1").Range("G25") ' Used to stop the second loop in range

    Worksheets(1).Activate
    Worksheets(1).Range("A1").Select  ' Has item to be pasted (a triangle)
    Selection.Copy

For Each ws In Worksheets
  Worksheets(ws.Name).Activate

    With Range("C4:G25")
        Set Rng = .Find(1, LookIn:=xlValues)

        If Not Rng Is Nothing Then
            FirstAddress = Rng.Address
            Do

                Rng.Activate
                ActiveSheet.Paste

                    Do

                        OffNumber = Range("A" & ActiveCell.Row)
                        Set OffsetRange = SetRange.Offset(0, -OffNumber)
                            If Not ActiveCell.Address < OffsetRange.Address Then
                                Exit Do
                            Else
                                End If

                        ActiveCell.Offset(, OffNumber).Select
                        ActiveSheet.Paste
                    Loop While (ActiveCell.Address <= OffsetRange.Address)

                    On Error GoTo ErrorLine

                Set Rng = .FindNext(Rng)
            Loop While Not Rng Is Nothing And Rng.Address <> FirstAddress

        End If

    End With

ErrorLine:
On Error GoTo 0
Application.EnableEvents = True

Next ws

Application.CutCopyMode = False

End Sub

```