excel - 从多张纸中复制彩色单元格并粘贴到一张纸中

Question

我有多张包含数据的工作表。我用不同的颜色(大部分是绿色)突出显示了每张工作表中的一些行，我想将这些行复制到一个工作表中

到目前为止我已经得到了什么

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

我希望 ..<> RGB(255, 255, 255)会捕获任何颜色，因为它是它以默认颜色代码返回的值，对吗？或者会xlNone更正确吗？

Answer 1

您的代码中有一些错误，这是您的修正代码:

   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

要仅将数据复制为值，请使用:

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

请注意，这不会复制格式，如果您还需要复制数字格式等，请添加此行:

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