在Excel 2013中复制单元格并更改BG颜色 [英] Copying Cells and Changing BG color in Excel 2013

问题描述

我正在尝试在Excel中为正在讨论的项目创建摘要页面.工作簿中的每个单独工作表都将包含项目，状态，预期的ROI等内容.工作簿的第一页将总结每个项目的重点，每行一个项目.

I am attempting to create a summary page in Excel for projects under discussion. Each separate sheet in the workbook will have a writeup of the project, status, expected ROI, etc. The first page in the workbook will have a summary of salient points from each project, one project per line.

这是我拥有的代码，改编自

Here is the code that I have, adapted from this answer here, since I am not copying a range but rather specific cells.

Private Sub Worksheet_Activate()
Dim ws As Worksheet, sh As Worksheet, pRng As Range
Dim rNum As Integer
Dim nModCheck As Integer

Set ws = Sheets("Project Summary Page")
rNum = 6
For Each sh In Sheets
    If sh.Name <> ws.Name Then
        If sh.Name <> "Sheet3" Then
            sh.Range("B3").Copy

            Set pRng = ws.Cells(rNum, 2).End(xlUp).Offset(1, 0)
            pRng.PasteSpecial Paste:=xlPasteFormats
            pRng.PasteSpecial Paste:=xlPasteValues

            nModCheck = rNum Mod 2
            If nModCheck = 0 Then
                Selection.Interior.ColorIndex = 15
            End If

            sh.Range("C8").Copy
            Set pRng = ws.Cells(rNum, 3).End(xlUp).Offset(1, 0)
            pRng.Select
            If nModCheck = 0 Then
                Selection.Interior.ColorIndex = 15
            End If
            pRng.PasteSpecial Paste:=xlPasteFormats
            pRng.PasteSpecial Paste:=xlPasteValues

            rNum = rNum + 1
        End If
    End If
    Application.CutCopyMode = 0
    ws.Cells(rNum, 1).Value = rNum
Next sh
'Columns("B:K").EntireColumn.AutoFit
 End Sub

我得到的行为是，在第一次激活时，该副本将按预期运行，即. sheet2:B3复制到摘要页面:B6，sheet2:C8复制到摘要页面:C6，sheet4:B3复制到摘要页面:B7，等等.

The behavior that I am getting is that on the first activation, the copy functions as expected, ie. sheet2:B3 gets copied to summary page:B6, sheet2:C8 gets copied to summary page:C6, sheet4:B3 to summary page:B7 , etc.

异常表现:

• 如果我单击摘要页面并返回，则所有数据仅复制到第一行. (因此，sheet2数据出现在正确的行中，然后被后续的工作表覆盖.)
• 仅更改B6的背景.没有其他单元格发生改变-解决了

• If I click off the summary page and back, all data gets copied only to the first line. (So sheet2 data appears in the correct row, then it gets overwritten by subsequent sheets).
• Only the background for B6 gets changed. No other cell gets changed - Solved

如果我从摘要页面手动清除数据并重新激活，则可以按预期的方式填充数据.如果我清除代码中的区域，它也可以工作.当单元格中已有数据导致其不前进到下一行时，偏移量有何不同?

If I manually clear the data from the summary page and reactivate, it works as expected for the data fill. It also works if I clear the area in code. What is different about the offset when there is data already in a cell that causes it not to advance to the next row?

我尝试了几种不同的方法，关于多次运行中缺少什么的任何指针?

I've tried a few different approaches, any pointers on where I am missing something on multiple runs?

推荐答案

需要移动设置颜色代码.

It's need to move setting color code.

Private Sub Worksheet_Activate()
Dim ws As Worksheet, sh As Worksheet, pRng As Range
Dim rNum As Integer
Dim nModCheck As Integer

Set ws = Sheets("Project Summary Page")
rNum = 6
For Each sh In Sheets
    If sh.Name <> ws.Name Then
        If sh.Name <> "Sheet3" Then
            sh.Range("B3").Copy

            Set pRng = ws.Cells(rNum, 2).End(xlUp).Offset(1, 0)
            pRng.PasteSpecial Paste:=xlPasteFormats
            pRng.PasteSpecial Paste:=xlPasteValues

            nModCheck = rNum Mod 2
            If nModCheck = 0 Then
                'Selection.Interior.ColorIndex = 15
                pRng.Interior.ColorIndex = 15
            End If

            sh.Range("C8").Copy
            Set pRng = ws.Cells(rNum, 3).End(xlUp).Offset(1, 0)
            'pRng.Select

            pRng.PasteSpecial Paste:=xlPasteFormats
            pRng.PasteSpecial Paste:=xlPasteValues

            If nModCheck = 0 Then  '<~~ moved
                'Selection.Interior.ColorIndex = 15
                pRng.Interior.ColorIndex = 15
            End If

            rNum = rNum + 1
        End If
    End If
    Application.CutCopyMode = 0
    ws.Cells(rNum, 1).Value = rNum
Next sh

End Sub

这篇关于在Excel 2013中复制单元格并更改BG颜色的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！