复制单元格背景色并将其粘贴到另一张纸的相应单元格中 [英] Copy cell background color and paste it to corresponding cell of another sheet

问题描述

我在工作表1上有值，并使用条件格式设置了背景色.

I have values on Sheet 1 and I gave the background color using conditional formatting.

我只想复制颜色并将其粘贴到工作表2的相应单元格中，而无需粘贴值.

I want to copy only the color and paste it to the corresponding cell of sheet 2 without pasting the value.

例如，如果工作表1单元格A1的红色为特定值，则将颜色转移到工作表2 A1.

Example if sheet 1 cell A1 has red color for specific value, transfer the color to sheet 2 A1.

我使用红色和白色两种颜色.红色表示较高的值，白色表示较低的值.

I use two colors, red and white. Red is for higher value and white is for lower value.

Sub copycolor()
    Dim intRow As Integer
    Dim rngCopy As Range
    Dim rngPaste As Range

    For intRow = 1 To 20

        Set rngCopy = Sheet1.Range("A" & intRow + 0)
        Set rngPaste = Sheet2.Range("b" & intRow)

        'Test to see if rows 500+ have a value
        If rngCopy.Value <> "" Then

            'Since it has a value, copy the value and color
            rngPaste.Value = rngCopy.Value
            rngPaste.Interior.Color = rngCopy.Interior.Color

        End If
    Next intRow
End Sub

推荐答案

rngPaste.Interior.Color = rngCopy.DisplayFormat.Interior.Color

似乎为我工作.请记住，DisplayFormat是只读的，并且不允许在其使用的函数之外返回值.此外，它仅在Excel 2010 +

Seems to work for me. Keep in mind that DisplayFormat is read-only and is not allowed to return value outside of the function it's used in. Also it is only available in Excel 2010 +

我正在编辑我的答案，以包括您提到的其他内容，并意识到将其全部解释为单独的块变得令人困惑.这是实现您所说的推荐方法.

I was editing my answer to include the other stuff you mentioned and realized it was getting confusing to explain it all in separate chunks. Here's a recommended approach to achieve what you're saying.

Public Sub CopyColor()
Dim SourceSht As Worksheet
Dim TargetSht As Worksheet
Dim rngCopy As Range
Dim rngPaste As Range
Dim LastCopyRow As Long
Dim LastCopyColumn As Long

'Define what our source sheet and target sheet are
Set SourceSht = ThisWorkbook.Worksheets("Sheet1")
Set TargetSht = ThisWorkbook.Worksheets("Sheet2")

'Find our used space on the source sheet
LastCopyRow = SourceSht.Cells(Rows.Count, "A").End(xlUp).Row
LastCopyColumn = SourceSht.Cells(1, Columns.Count).End(xlToLeft).Column

'Setup our ranges so we can be sure we don't loop through unused space
Set rngCopy = SourceSht.Range("A1:" & SourceSht.Cells(LastCopyRow, LastCopyColumn).Address)
Set rngPaste = TargetSht.Range("A1:" & TargetSht.Cells(LastCopyRow, LastCopyColumn).Address)

'Loop through each row of each column.
' This will go through each cell in column 1, then move on to column 2
For Col = 1 To LastCopyColumn
    For cel = 1 To LastCopyRow
        ' If the string value of our current cell is not empty.
        If rngCopy.Cells(cel, Col).Value <> "" Then
            'Copy the source cell displayed color and paste it in the target cell
            rngPaste.Cells(cel, Col).Interior.Color = rngCopy.Cells(cel, Col).DisplayFormat.Interior.Color
        End If
    Next cel
Next Col
End Sub

这篇关于复制单元格背景色并将其粘贴到另一张纸的相应单元格中的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！