嘿，作为VBA新手能想到这种批量跨表的需求真的很赞！我帮你写了一段针对性的代码，完美匹配你的需求，而且注释很详细，你能轻松看懂每一步在做什么～

核心思路 #

我们要做的就是：

• 把月份工作表组（Mar 18到Dec 18）每行指定区域的单元格颜色，对应复制到站点工作表组（Site 1到Site 6）的指定列区域
• 用数组来批量存储工作表名称，避免重复写代码，后期要加新月份/站点也只要修改数组就行

完整VBA代码 #

Sub CopyCellColorsAcrossSheets()
    ' 定义月份工作表名称数组，按顺序对应站点工作表
    Dim monthSheets As Variant
    monthSheets = Array("Mar 18", "Apr 18", "May 18", "Jun 18", "Jul 18", "Aug 18", "Sep 18", "Oct 18", "Nov 18", "Dec 18")
    
    ' 定义站点工作表名称数组，和月份数组一一对应
    Dim siteSheets As Variant
    siteSheets = Array("Site 1", "Site 2", "Site 3", "Site 4", "Site 5", "Site 6")
    
    Dim wsMonth As Worksheet, wsSite As Worksheet
    Dim i As Integer, j As Integer
    
    ' 循环处理每一对月份表和站点表
    For i = LBound(monthSheets) To UBound(siteSheets)
        ' 检查工作表是否存在，避免报错
        On Error Resume Next
        Set wsMonth = ThisWorkbook.Worksheets(monthSheets(i))
        Set wsSite = ThisWorkbook.Worksheets(siteSheets(i))
        On Error GoTo 0
        
        ' 如果两个工作表都存在，才执行复制操作
        If Not wsMonth Is Nothing And Not wsSite Is Nothing Then
            ' 循环复制每个单元格的颜色：月份表B3-X3对应站点表B3-B23
            For j = 0 To 22 ' B到X共23个单元格，索引从0到22
                ' 把月份表第3行第(j+2)列的颜色，复制到站点表第(j+3)行第2列
                wsSite.Cells(j + 3, 2).Interior.Color = wsMonth.Cells(3, j + 2).Interior.Color
            Next j
            
            Debug.Print "已完成：" & monthSheets(i) & " → " & siteSheets(i)
        Else
            ' 如果工作表不存在，提示错误
            If wsMonth Is Nothing Then Debug.Print "错误：未找到工作表 " & monthSheets(i)
            If wsSite Is Nothing Then Debug.Print "错误：未找到工作表 " & siteSheets(i)
        End If
    Next i
    
    MsgBox "颜色复制操作完成！请查看立即窗口获取详细日志（按Ctrl+G打开）", vbInformation
End Sub

代码关键部分解释 #

• 数组定义：monthSheets和siteSheets两个数组是一一对应的，比如monthSheets(0)（Mar 18）对应siteSheets(0)（Site 1），你可以根据实际情况添加/删除数组元素
• 工作表存在性检查：用On Error Resume Next和Is Nothing判断工作表是否存在，避免因工作表名称写错导致代码崩溃
• 颜色复制逻辑：Interior.Color是获取/设置单元格填充颜色的属性，我们通过循环把月份表第3行的B列到X列（共23个单元格）的颜色，依次复制到站点表B列的第3行到第23行
• 日志输出：用Debug.Print记录操作结果，你可以按Ctrl+G打开立即窗口查看哪些表成功复制，哪些表找不到

使用步骤 #

1. 打开你的Excel文件，按Alt+F11打开VBA编辑器
2. 在左侧工程窗口里，右键点击你的工作簿，选择插入→模块
3. 把上面的代码粘贴到模块里
4. 按F5运行代码，或者回到Excel里，点击开发工具→宏，选择CopyCellColorsAcrossSheets执行

内容的提问来源于stack exchange，提问作者JMorphett