复制单元格背景颜色，并通过其他图纸的相应单元格 [英] copy cell background color and past it corresponding cell of another sheet

问题描述

我一直在尝试编写一个宏来复制单元格背景颜色，并将其过去到另一张表的相应单元格。我在Sheet 1上有很多值，而且我使用条件格式给出背景颜色，之后我想复制只有颜色和过去它相应的单元格2没有粘贴值。例如，如果图纸1单元格A1具有特定值的红色，我想将颜色转移到图纸2 A1。我给了excel表1的图片，还有我的代码。

  Sub copycolor（）
 Dim intRow As Integer 
 Dim rngCopy As Range 
 Dim rngPaste As Range 
 
 
 
对于intRow = 1至20 
 
 
设置rngCopy = Sheet1.Range（A& intRow + 0）
设置rngPaste = Sheet2.Range（b& intRow）
 
'测试以查看行500+是否有值
如果rngCopy.Value<> 然后
 
'由于它有一个值，复制值和颜色
 rngPaste.Value = rngCopy.Value 
 rngPaste.Interior.Color = rngCopy.Interior.Color 
 
 
结束如果
下一个intRow 
 End Sub 
  

我使用条件格式化来给出颜色，这里我使用两个color.one是红色，另一个是white.Red使用更高的值，而white是较低的vaue。如果你帮我解决这个问题，那将是很好的

解决方案

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

似乎适合我。请记住，DisplayFormat是只读的，不允许在其使用的函数之外返回值。此外，它仅在Excel 2010 +

中可用编辑我的答案，包括您提到的其他内容，并意识到它变得混乱，以分开的方式解释。这是一个推荐的方法来实现你所说的话。

  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 
 
'定义我们的源表和目标表是
设置SourceSht = ThisWorkbook.Worksheets（Sheet1）
设置TargetSht = ThisWorkbook.Worksheets（Sheet2）
 
'查找源表上使用的空间
 LastCopyRow = SourceSht。单元格（Rows.Count，A）。End（xlUp）.Row 
 LastCopyColumn = SourceSht.Cells（1，Columns.Count）.End（xlToLeft）.Column 
 
'Setup我们的范围，所以我们可以确定我们不循环使用未使用的空间
设置rngCopy = SourceSht.Range（A1：& SourceSht.Cells（LastCopyRow，LastCopyColumn）.Address）
设置rngPaste = TargetSht.Range（A1：& TargetSht.Cells（LastCopyRow，LastCopyColumn）.Address）
 
'循环每列的每一行。 
'这将通过列1中的每个单元格，然后移动到列2 
对于Col = 1到LastCopyColumn 
对于cel = 1 To LastCopyRow 
'如果字符串值我们当前的单元格不是空的。 
如果rngCopy.Cells（cel，Col）.Value<> 然后
'复制源单元格显示的颜色并将其粘贴到目标单元格
 rngPaste.Cells（cel，Col）.Interior.Color = rngCopy.Cells（cel，Col）.DisplayFormat.Interior .Color 
 End If 
 Next cel 
 Next Col 
 End Sub 
  

I have been trying to write a macro to copy cell background color and past it to corresponding cell of another sheet.I have lots of values on Sheet 1 and I gave the background color using conditional formatting ,after that I want to copy only the color and past it corresponding cell of sheet 2 without pasting value.Example if sheet 1 cell A1 has red color for specific value ,i want to transfer the color to sheet 2 A1. I am giving the picture of excel sheet 1 and also my code.

    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

I use conditional formatting for giving color and here I use two color.one is red and another one is white.Red is use higher value and white is for lower vaue. It would be nice if you help me out from this problem.

解决方案

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

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屋！