调整现有VBA宏，使其同时复制单元格背景填充颜色

下面是修改后的完整代码，已实现同时复制单元格值与背景颜色的功能：

Sub test()
  Dim sh1 As Worksheet, sh As Worksheet
  Dim f As Range
  Dim j As Long, lr1 As Long, lr As Long

  Set sh1 = Sheets("Labor Mapping")
  
  With Sheets("Labor Mapping")
    .Rows(2 & ":" & .Rows.Count).Clear
  End With
  
  For Each sh In Sheets
    If sh.Name <> sh1.Name Then
      lr1 = sh1.Cells.Find("*", , xlValues, , xlByRows, xlPrevious).Row + 1
      lr = sh.Cells.Find("*", , xlValues, , xlByRows, xlPrevious).Row
      
      For j = 1 To sh.Cells(1, Columns.Count).End(xlToLeft).Column
        Set f = sh1.Rows(1).Find(sh.Cells(1, j), , xlValues, xlWhole, , , False)
        
        If Not f Is Nothing Then
          ' 复制单元格值
          sh1.Cells(lr1, f.Column).Resize(lr).Value = sh.Cells(2, j).Resize(lr).Value
          ' 复制单元格背景颜色
          sh1.Cells(lr1, f.Column).Resize(lr).Interior.Color = sh.Cells(2, j).Resize(lr).Interior.Color
        End If
      Next
    End If
  Next
  
  Sheets("Labor Mapping").Columns("G").Delete
End Sub

核心修改说明 #

• 在原代码复制值的语句后，新增Interior.Color赋值逻辑，批量将源区域的背景颜色同步到目标区域
• 把原代码中End(1)替换为官方枚举常量xlToLeft，提升代码可读性

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