将多个 Excel 选项卡中的彩色字体行复制到同一工作簿的最终选项卡中答案

【问题标题】：Copy coloured font rows from multiple Excel tabs into final tab on same workbook将多个 Excel 选项卡中的彩色字体行复制到同一工作簿的最终选项卡中
【发布时间】：2023-01-28 09:39:14
【问题描述】：

我在 Excel 文档中有标签（例如 580400 / 580401 / 580402 / 580403）。

每个选项卡中的某些条目行具有条件格式，可将某些行变为蓝色。

我正在尝试将所有蓝色字体行复制到同一工作簿中另一个名为“Sheet2”的选项卡。

我在一个选项卡 (580400) 上完成了这项工作。

如何包含其他选项卡 (580401 / 580402 / 580403)？

Sub CopyColouredFontTransactions()

Dim PeriodField As Range
Dim PeriodCell As Range
Dim Sheet1WS As Worksheet
Dim Sheet2WS As Worksheet

Dim x As Long

Set Sheet1WS = Worksheets("580400")
Set PeriodField = Sheet1WS.Range("A2", Sheet1WS.Range("A2").End(xlDown))
Set Sheet2WS = Worksheets("Sheet2")

For Each PeriodCell In PeriodField

    If PeriodCell.Font.Color = RGB(0, 176, 240) Then
        
        PeriodCell.Resize(1, 15).Copy Destination:= _
          Sheet2WS.Range("A1").Offset(Sheet2WS.Rows.Count - 1, 0).End(xlUp).Offset(1, 0)
            
    End If

Next PeriodCell

Sheet2WS.Columns.AutoFit

End Sub

【问题讨论】：

如果使用条件格式设置字体，PeriodCell.Font.Color 将看不到颜色。您将需要使用 PeriodCell.DisplayFormat.Font.Color 来获取使用条件格式应用的颜色
尝试遍历每张纸？

标签： excel vba

【解决方案1】：

您可以尝试添加一个 for next 循环，该循环将迭代一组工作表名称。请参见下面的示例（未测试）

Sub CopyColouredFontTransactions()
Dim PeriodField As Range
Dim PeriodCell As Range
Dim Sheet1WS As Worksheet
Dim Sheet2WS As Worksheet

Dim x As Long

Set Sheet2WS = Worksheets("Sheet2")

Dim tabs As Variant
Set tabs = Array("580400", "580401", "580403")

Dim tabname As String

For Each tabname In tabs
    Set Sheet1WS = Worksheets(tabname)
    Set PeriodField = Sheet1WS.Range("A2", Sheet1WS.Range("A2").End(xlDown))

    For Each PeriodCell In PeriodField
        If PeriodCell.Font.Color = RGB(0, 176, 240) Then
            PeriodCell.Resize(1, 15).Copy Destination:= _
            Sheet2WS.Range("A1").Offset(Sheet2WS.Rows.Count - 1, 0).End(xlUp).Offset(1, 0)
        End If
    Next PeriodCell
Next tabs

Sheet2WS.Columns.AutoFit

结束子

【讨论】：