Solved How can i find data in a sheet and copy to alternate sheet

Microsoft Office excel 2003
June 21, 2016 at 02:24:47
Specs: Windows 7

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 with
Cells(iRow, 10).value 
has a formula I want to past into the cell excel will not let me.

Please help this has had me stumped for ages.

See More: How can i find data in a sheet and copy to alternate sheet

Reply ↓  Report •

June 21, 2016 at 04:11:50

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

You can't have a sheet with varying amounts of sheets. I assume you have a workbook with 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.

Reply ↓  Report •

June 21, 2016 at 04:40:15
✔ Best Answer
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

Reply ↓  Report •

June 21, 2016 at 06:28:15
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.

Reply ↓  Report •

Related Solutions

June 21, 2016 at 06:37:58
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.

Reply ↓  Report •

Ask Question