Copying Rows With Highlighted Cells Multiple Columns

[barim]

Hello,

I have this code that extracts rows with highlighted cells based on which column I point to. Right now it points to column "C".
My data range spans from Column C through Column N.
Each time I run this code I manually change column reference. Highlighted cells can be found anywhere between Columns C:N.
Is there a way to copy all of the rows with one click without the need to manually change column reference?

This is the piece of code that I change each time:

If Sheets("1").Range("C" & i).Interior.ColorIndex <> xlNone Then

This is the whole macro:

Sub CopyHighlightedRows()
   Dim LastRow As Long
   Dim i As Long, j As Long

   With Worksheets("1")
   LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
   End With

   With Worksheets("Report")
   j = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
   End With

   For i = 2 To LastRow
       With Worksheets("1")
           If Sheets("1").Range("C" & i).Interior.ColorIndex <> xlNone Then
               .Rows(i).Copy Destination:=Worksheets("Report").Range("A" & j)
               j = j + 1
           End If
       End With
   Next i
End Sub

 

[mrshl9898]

How's this looking?

Sub CopyHighlightedRows()
   Dim LastRow As Long
   Dim i As Long, j As Long, C As Long


   With Worksheets("1")
   LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
   End With


   With Worksheets("Report")
   j = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
   End With
   
   C = 3
   
For C = 3 To 14
   For i = 2 To LastRow
       With Worksheets("1")
       Sheets("1").Cells(i, C).Select
           If Sheets("1").Cells(i, C).Interior.ColorIndex <> xlNone Then
               .Rows(i).Copy Destination:=Worksheets("Report").Range("A" & j)
               j = j + 1
           End If
       End With
   Next i
i = 2
Next C
   
End Sub

 

[barim]

Sir, thank you so much for your response. I tested it and I had to cancel, because it ran for too long. I have a lot of data. Is there a way to speed up this process?
Thanks again.

 

[mrshl9898]

Maybe a better way would be to do an IF OR when looking at the cells? To see if any are highlighted?

So, your original with:

If Sheets("1").Range("C" & i).Interior.ColorIndex <> xlNone or Sheets("1").Range("D" & i).Interior.ColorIndex <> xlNone....etc Then