Searches all sheets in wb for exact string in column, copy/paste certain data from row

I have a macro (much thanks and kudos to arlu) that will search through a workbook and pull data from a certain column in each sheet. What I need now is to be able to pull other parts of the row that data is in onto that same sheet.
Macro is:

Sub cons_data()
Dim i As Long, lrow As Long

Application.ScreenUpdating = False

For i = 1 To Worksheets.Count
    With Worksheets(i)
        If .Name <> "Recommendations" Then
            lrow = .Range("L" & .Rows.Count).End(xlUp).Row
            If lrow > 9 Then .Range("L10:L" & lrow).Copy Worksheets("Recommendations").Range("B" & Rows.Count).End(xlUp).Offset(1, 0)
        End If
    End With
Next i

With Worksheets("Recommendations")
    lrow = .Range("B" & .Rows.Count).End(xlUp).Row
    .Range("B5:B" & lrow).RemoveDuplicates Columns:=1, Header:=xlYes
End With


MsgBox "Done"

Application.ScreenUpdating = True

End Sub

I need to pull the person responsible, the Risk ranking L&S which are the highest for Personnel, and the highest for Environmental, and then the Item no. which corresponds to those rankings.

I have attached a testbook which gives an example.

Thank you very much to anyone who can assist me!

bcas77,

Something like this?

Sub tgr()
    
    Dim ws As Worksheet
    Dim wsDest As Worksheet
    Dim rngFound As Range
    Dim arrData(1 To 65000, 1 To 9)
    Dim DataIndex As Long
    Dim strFirst As String
    
    DataIndex = 0
    Set wsDest = Sheets("Recommendations")
    wsDest.Range("B6:M" & Rows.Count).ClearContents
    
    For Each ws In Sheets
        If ws.Name <> wsDest.Name Then
            Set rngFound = ws.Range("L10:L" & Rows.Count).Find("*", ws.Cells(Rows.Count, "L"), xlValues, xlWhole)
            If Not rngFound Is Nothing Then
                strFirst = rngFound.Address
                Do
                    DataIndex = DataIndex + 1
                    arrData(DataIndex, 1) = ws.Cells(rngFound.Row, "L").Text    'Recommendation
                    arrData(DataIndex, 2) = ws.Name                             'Section
                    arrData(DataIndex, 3) = ws.Cells(rngFound.Row, "F").Text    'Personnel Risk Ranking L
                    arrData(DataIndex, 4) = ws.Cells(rngFound.Row, "G").Text    'Personnel Risk Ranking S
                    arrData(DataIndex, 5) = ws.Cells(rngFound.Row, "H").Text    'Personnel Risk Ranking R
                    arrData(DataIndex, 6) = ws.Cells(rngFound.Row, "I").Text    'Environmental Risk Ranking L
                    arrData(DataIndex, 7) = ws.Cells(rngFound.Row, "J").Text    'Environmental Risk Ranking S
                    arrData(DataIndex, 8) = ws.Cells(rngFound.Row, "K").Text    'Environmental Risk Ranking R
                    arrData(DataIndex, 9) = ws.Cells(rngFound.Row, "M").Text    'Person Responsible
                    Set rngFound = ws.Range("L10:L" & Rows.Count).Find("*", rngFound, xlValues, xlWhole)
                Loop While rngFound.Address <> strFirst
            End If
        End If
    Next ws
    
    If DataIndex > 0 Then wsDest.Range("B6").Resize(DataIndex, UBound(arrData, 2)).Value = arrData
    
    Set ws = Nothing
    Set wsDest = Nothing
    Set rngFound = Nothing
    Erase arrData
    
End Sub

Yeah, just change it from ws.Name to the same ws.Cells(rngfound.row, "column letter").text format of the others for the desired column letter.

couodln't you just set up the same conditional formats on your 'Recommendations' sheet? There doesn't really need to be VBA for that...

Can you post the code you're using? It's likely that you've adapted the code a bit, so I'd like to see exactly what the code is before I conjecture.

The code looks good to me. It might be a problem with merged cells. Are there any merged cells in column L of the other worksheets?

Hmm... I tested it with some merged cells but that isn't causing the error for me. Can you post a sample workbook that is experiencing the problem?

Ok, I figured it might be, but I couldn't reproduce the error on my machine. Glad to hear you've got it sorted. As far as merged cells go, anybody who's worked with Excel a lot will always tell you to never use merged cells at all costs.