不使用“.Copy”+“.Paste”粘贴格式

例如：

rngTo.Value = rngFrom.Value2 'Works rngTo.NumberFormat = rngFrom.NumberFormat 'Works rngTo.Cells.Interior.ColorIndex = rngFrom.Cells.Interior.ColorIndex 'Doesn't work rngToPublish.Copy: rNG.PasteSpecial xlPasteFormats ' Does work 

有没有办法得到这个所需的效果，而不使用xlPasteSpecial ？

Answer 1

从上面的评论你只是想复制填充颜色，看看这个例子：

 Sub CopyFillColour() Dim rCopy As Range, rPaste As Range Dim lRow As Long, lCol As Long Set rCopy = Range("A1:B4") Set rPaste = Range("C1:D4") '// Can be smaller than the copy range ie C1:C4 For lRow = 1 To rPaste.Rows.Count For lCol = 1 To rPaste.Columns.Count rPaste(lRow, lCol).Interior.Color = rCopy(lRow, lCol).Interior.Color rPaste(lRow, lCol).Interior.Pattern = rCopy(lRow, lCol).Interior.Pattern rPaste(lRow, lCol).Interior.PatternColorIndex = rCopy(lRow, lCol).Interior.PatternColorIndex Next lCol Next lRow End Sub 

就像我讨厌循环一样，这可能是你需要的情况。

Answer 2

我喜欢蒂姆的评论，但也看看你在写什么，你有一个额外的Cells在那里尝试没有Cells ，看看它是否工作。

 rngTo.Interior.ColorIndex = rngFrom.Interior.ColorIndex 

更新：只有在整个范围内colorindex是相同的值时，上述代码才起作用，否则不起作用。

更新2：

这将为你做。 之前发生的事情是， ColorIndex不包含一个数组，只有一个值，所以如果它有多个值，它将返回一个Null值。 Color也不包含多个值，所以如果它包含多个值，则返回白色。

 Private Sub ColorRange() 'Dim dicColors As Dictionary Dim dicColors As Object Dim dColor As Double Dim rCopy As Range, rPaste As Range, rNext As Range Dim wksCopy As Worksheet, wksPaste As Worksheet Dim vColor As Variant Set wksCopy = ActiveWorkbook.Worksheets("Sheet1") Set wksPaste = ActiveWorkbook.Worksheets("Sheet2") Set rCopy = wksCopy.UsedRange 'Set dicColors = New Dictionary Set dicColors = CreateObject("Scripting.Dictionary") 'Loop through entire range and get colors, place in dictionary. For Each rNext In rCopy dColor = rNext.Interior.Color If dicColors.Exists(dColor) Then Set dicColors(dColor) = Union(dicColors(dColor), wksPaste.Range(rNext.Address)) Else Set rPaste = wksPaste.Range(rNext.Address) dicColors.Add dColor, rPaste End If Next rNext 'Color the ranges For Each vColor In dicColors.Keys 'If color isn't white then color it, otherwise leave black, if the 'worksheet you are copying to has colors already then you should do an 'else statement to get rid of the coloring like this 'dicColors(vColor).Interior.ColorIndex = xlNone If vColor <> 16777215 Then dicColors(vColor).Interior.Color = vColor Next vColor End Sub