Worksheet Loop searching for yellow

[sscornav]

Any help would be appreciated, this is beyond my capabilities.

I need to loop through all of the worksheets in a workbook ( I could also but all of the worksheet names in a named range) and copy any rows that have any yellow highlight in them. They should be copied into a separate worksheet called "XXX"

Thanks!

 

[sscornav]

What would be the syntax to copy the row with "Values and format"?

currentRow.Copy destinationWorksheet.Cells(rowNumber, "a")

 

[Domenic]

Try the following macro, which has been amended to paste values and formats. Note that ScreenUpdating has been set to False at the beginning of the macro to prevent the screen from updating and improve efficient. And it's set back to True and the end of the macro.

Sub CopyRows()

    Dim destinationWorksheet As Worksheet
    Dim currentWorksheet As Worksheet
    Dim currentRow As Range
    Dim currentCell As Range
    Dim rowNumber As Long
    
    Application.ScreenUpdating = False
    
    Set destinationWorksheet = Worksheets("XXX")
    
    destinationWorksheet.Cells.Clear
    
    rowNumber = 2 'start at Row 2
    For Each currentWorksheet In ActiveWorkbook.Worksheets
        If currentWorksheet.Name <> destinationWorksheet.Name Then
            For Each currentRow In currentWorksheet.UsedRange.Rows
                For Each currentCell In currentRow.Cells
                    If Not IsError(currentCell) Then
                        If InStr(1, currentCell.Value, "XYZ", vbTextCompare) > 0 Then
                            If currentCell.Interior.Color = vbYellow Then
                                currentRow.Copy
                                With destinationWorksheet.Cells(rowNumber, "a")
                                    .PasteSpecial xlPasteValues
                                    .PasteSpecial xlPasteFormats
                                End With
                                rowNumber = rowNumber + 1
                                Exit For
                            End If
                        End If
                    End If
                Next currentCell
            Next currentRow
        End If
    Next currentWorksheet
    
    With destinationWorksheet
        .Activate
        .Cells(1).Select
    End With
    
    Application.ScreenUpdating = True
    
End Sub

 

[sscornav]

Thanks so much for your help Domenic!