CODEWITHSUNDEEP
excelvba
Andreas Rasmussen
Andreas Rasmussen

Reputation: 35

Copy colored cells from multiple sheets & paste into one sheet

I've got multiple sheets with data in them. I've highlighted some rows in each sheet with different colors (mostly green), and I'd like to copy these, into one sheet

What I've got so far

Sub Copy_If_colored()
   Dim sh As Worksheet, N As Long
   Dim i As Long, M As Long, J As Long
   Dim xCell As Range, xRg As Range


   N = Sheets.Count - 1
   M = 2

   For i = 1 To N
   J = Sheets(i).UsedRange.Rows.Count
   Set xRg = Sheets(i).Range("A1:A" & J)
       For Each xCell In xRg

           If xCell.Interior.Color <> RGB(255, 255, 255) Then
               Sheets(i).Range(xCell).Copy
               Sheets("Recommended").Range("A" & M).PasteSpecial (xlValues)
               Sheets("Recommended").Range("A" & M).PasteSpecial (xlFormats)
               M = M + 1
           End If

       Next
   Next i
End Sub

I was hoping the ..<> RGB(255, 255, 255) would catch any color since it's the value it returns in the default colorcode, right? Or would xlNone be more correct?

Upvotes: 2

Views: 286

Answers (2)

riskypenguin
riskypenguin

Reputation: 2199

There are a few mistakes in your code, here is your fixed code:

   Sub Copy_If_colored()
   Dim sh As Worksheet
   Dim i As Long, M As Long
   Dim rngRow As Range

   M = 2 'Start at second row, since first row contains headers

   For i = 1 To Sheets.Count - 1 'Make sure "Recommended" is the last sheet
       For Each rngRow In Sheets(i).UsedRange.Rows 'Going through rows instead of every cell should be considerably faster
           If Sheets(i).Range("A" & rngRow.Row).Interior.ColorIndex <> xlNone Then
               rngRow.Copy Sheets("Recommended").Range("A" & M)
               M = M + 1
           End If
       Next
   Next i
End Sub

To only copy the data as values, use this:

rngRow.Copy
Sheets("Recommended").Range("A" & M).PasteSpecial xlValues

Note that this does not copy formatting, if you need number formats etc. to be copied as well, add this line:

Sheets("Recommended").Range("A" & M).PasteSpecial xlFormats

Upvotes: 3

Teamothy
Teamothy

Reputation: 2016

If You want to compare with RGB instead of:

If CStr(xCell.Value) <> RGB(255, 255, 255) Then

try to use:

If xCell.Interior.Color <> RGB(255, 255, 255) Then

Also You need to set range xRg

Upvotes: 1

Related Questions