Worksheet Loop searching for yellow

sscornav

Board Regular
Joined
Mar 20, 2010
Messages
125
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!
 
What would be the syntax to copy the row with "Values and format"?

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

Excel Facts

Fastest way to copy a worksheet?
Hold down the Ctrl key while dragging tab for Sheet1 to the right. Excel will make a copy of the worksheet.
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.

Code:
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
 
Upvote 0

Forum statistics

Threads
1,213,564
Messages
6,114,334
Members
448,567
Latest member
Kuldeep90

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top