Microsoft Office excel 2003

Hi, I have a sheet that can have a varying amount of sheets. I am trying to do a macro

that will search all sheets (from sheet 6 to last sheet) and find any rows with data

that have a value in column R that has a value above 7. Once this data is found

then it needs to be copied to the next empty row on a separate sheet.below is the code I have put together but is does not work.

Dim WS_Count As Integer Dim I As Integer Dim cel As Range, rng As Range Dim LastRow As Long Dim emptyRow As Long Dim iRow As Long Set ws = Worksheets("Residual Risk") WS_Count = ActiveWorkbook.Worksheets.Count For I = 6 To WS_Count ' LastRow = Sheets(I).Cells(Rows.Count, "A").End(xlUp).Row Set rng = Sheets(I).Range("r7:r" & LastRow) For Each cel In rng If UCase(cel.Value) >= 7 Then 'Make Sheet active Sheets("Residual Risk").Activate 'Determine emptyRow iRow = ws.Cells.Find(What:="*", SearchOrder:=xlRows, _ SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1 'Transfer information ws.Cells(iRow, 1).Value = Sheets(I).Range("B1") ' topic Cells(iRow, 2).Value = Sheets(I).Cells(B2) 'event topic ws.Cells(iRow, 3).Value = Sheets(I).Cells(cel, 1) ' risk Cells(iRow, 4).Value = Sheets(I).Cells(cel, 2) ' who Cells(iRow, 5).Value = Sheets(I).Cells(cel, 7) ' design controls Cells(iRow, 6).Value = Sheets(I).Cells(cel, 8) ' residual controls Cells(iRow, 7).Value = Sheets(I).Cells(cel, 9) ' residual likliehood Cells(iRow, 8).Value = Sheets(I).Cells(cel, 10) ' Residual severity Cells(iRow, 9).Value = Sheets(I).Cells(cel, 11) ' residual risk Cells(iRow, 10).Value = Sheets(I).Cells(cel, 12)().formula = "=IF(E7<=4,"Trivial",IF(E7<=6,"Acceptable",IF(E7<=9,"Moderate",IF(E7<14,"Substantial",IF(E7<=25,"Intolerable",)))))" ' comment Cells(iRow, 11).Value = Sheets(I).Cells(cel, 14) ' comments Sheets("Input Sheet").Activate '------------------------------------ End If Next cel Next I MsgBox "The document has derived the residual risks" Application.ScreenUpdating = True Sheets("Input Sheet").Activate End Sub

Also the line withCells(iRow, 10).valuehas a formula I want to past into the cell excel will not let me.Please help this has had me stumped for ages.

re:"I have a sheet that can have a varying amount of sheets."You can't have a

sheetwith varying amounts of sheets. I assume you have aworkbookwith varying amounts sheets.re:

"below is the code I have put together but is does not work."Please keep in mind that we cannot see your workbook from where we are sitting. What do you mean by it "does not work"? Is it giving you an error message? Is it not copying the rows you want copied? Is it not finding the values you want found? Etc.

We need some more details before we can offer any assistance.

re:

" also the line with

Cells(iRow, 10).value "Your code shows you setting the value of that cell equal to the value of a different cell's formula and then setting the whole thing equal to a different formula. Not only won't that work, it doesn't even make sense. What are you trying to do with that instruction?

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.

Maybe I have understood your code and requirement correctly, but from

what I have understood I have come up with the following.Sub DoStuff() Dim Bcell As Range Dim NextRow For I = 6 To Sheets.Count For Each Bcell In Sheets(I).Range("R1", Sheets(I).Range("R" & Rows.Count).End(xlUp)) If Bcell.Value >= 7 Then NextRow = Sheets("Residual Risk").Range("A" & Rows.Count).End(xlUp).Row + 1 Sheets("Residual Risk").Range("A" & NextRow) = Sheets(I).Range("B1") Sheets("Residual Risk").Range("B" & NextRow) = Sheets(I).Range("B2") Sheets("Residual Risk").Range("C" & NextRow) = Sheets(I).Range("A" & Bcell.Row) Sheets("Residual Risk").Range("D" & NextRow) = Sheets(I).Range("B" & Bcell.Row) Sheets("Residual Risk").Range("E" & NextRow) = Sheets(I).Range("G" & Bcell.Row) Sheets("Residual Risk").Range("F" & NextRow) = Sheets(I).Range("H" & Bcell.Row) Sheets("Residual Risk").Range("G" & NextRow) = Sheets(I).Range("I" & Bcell.Row) Sheets("Residual Risk").Range("H" & NextRow) = Sheets(I).Range("J" & Bcell.Row) Sheets("Residual Risk").Range("I" & NextRow) = Sheets(I).Range("K" & Bcell.Row) Sheets("Residual Risk").Range("J" & NextRow).Formula = "=IF(E" & NextRow & "<=4," & """" & "Trivial" & """" & ",IF(E" & NextRow & "<=6," & """" & "Acceptable" & """" & ",IF(E" & NextRow & "<=9," & """" & "Moderate" & """" & ",IF(E" & NextRow & "<14," & """" & "Substantial" & """" & ",IF(E" & NextRow & "<=25," & """" & "Intolerable" & """" & ")))))" Sheets("Residual Risk").Range("K" & NextRow) = Sheets(I).Range("N" & Bcell.Row) End If Next Bcell Next I End Sub

EDIT: Sorry Derby I didn't see your post, I had the page open on this thread while I

was writing the code and doing other stuff

Hi Derby, Yes I meant workbook rather than sheets.

The code only brings up the msg box and changes the active sheet. It does not find and transfer the data. I need the macro to search all sheets from 6 onwards and find a specific value (derived from a formula in the R column) and copy certain data to the residual risks sheet.

re:" also the line with Cells(iRow, 10).value " - I am trying to get the next row on the "residual risk" sheet (iRows) equal the data from the found data in the sheets(I).

Hi alwayswillingtolearn

Thanks for the code, it works for the majority and I can hopefully fix the little bugs I have.

Awesome, I was just a little confused so coded as I read the description and code in your original post, if you get stuck let us know and we'll do what we can to help. Thanks for getting back to us.

Ask Your Question

Weekly Poll