如何在将多行转置为单列时复制单元格颜色？

原代码仅复制了单元格的数值，未同步格式属性，因此无法复制单元格颜色。以下两种方案可解决该问题：

方案1：完整复制内容与格式（推荐） #

使用Copy结合PasteSpecial方法，一次性复制源单元格的所有格式（包括填充色、字体、数字格式等）和数值：

Sub SnakeWithFormat()
  Dim N As Long, i As Long, K As Long, j As Long
  Dim sh1 As Worksheet, sh2 As Worksheet
  K = 1
  Set sh1 = Sheets("Sheet5")
  Set sh2 = Sheets("Sheet6")
  N = sh1.Cells(Rows.Count, "A").End(xlUp).Row

  For i = 1 To N
   For j = 1 To Columns.Count
     If sh1.Cells(i, j) <> "" Then
        sh1.Cells(i, j).Copy
        ' 粘贴源单元格的所有内容和格式
        sh2.Cells(K, 1).PasteSpecial Paste:=xlPasteAllUsingSourceTheme
        K = K + 1
     Else
        Exit For
     End If
  Next j
Next i
' 清除剪贴板，避免后续操作干扰
Application.CutCopyMode = False
End Sub

方案2：仅同步单元格填充颜色（高效） #

若只需同步背景填充色，无需其他格式，可直接赋值颜色属性，执行效率更高：

Sub SnakeWithColorOnly()
  Dim N As Long, i As Long, K As Long, j As Long
  Dim sh1 As Worksheet, sh2 As Worksheet
  K = 1
  Set sh1 = Sheets("Sheet5")
  Set sh2 = Sheets("Sheet6")
  N = sh1.Cells(Rows.Count, "A").End(xlUp).Row

  For i = 1 To N
   For j = 1 To Columns.Count
     If sh1.Cells(i, j) <> "" Then
        sh2.Cells(K, 1).Value = sh1.Cells(i, j).Value
        ' 同步背景填充色
        sh2.Cells(K, 1).Interior.Color = sh1.Cells(i, j).Interior.Color
        ' 如需同步字体颜色，添加以下行：
        ' sh2.Cells(K, 1).Font.Color = sh1.Cells(i, j).Font.Color
        K = K + 1
     Else
        Exit For
     End If
  Next j
Next i
End Sub

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