Excel VBA转置数据仅粘贴值：修改代码去除格式复制

要解决复制时连带格式的问题，有两种常用方案，都能实现仅传递单元格值：

方案1：直接赋值（推荐，高效无剪贴板依赖） #

这种方法跳过剪贴板，直接将源区域的值赋值给目标区域，速度更快且不会干扰用户剪贴板内容：

Sub transpLeagueTable()
    Dim targetrow As Long
    Dim i As Long
    Dim sourceRng As Range
    Dim destRng As Range
    
    targetrow = 6
    ' 遍历需要处理的行
    For i = 8 To ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
        ' 定义当前行的源数据区域（A列 + C-J列）
        Set sourceRng = ActiveSheet.Range("A" & i & ",C" & i & ":J" & i)
        ' 匹配目标区域的大小，确保和源区域一致
        Set destRng = Worksheets("League Table CSV").Cells(targetrow, 2 + (i - 8) * 9).Resize(sourceRng.Rows.Count, sourceRng.Columns.Count)
        ' 仅传递值，不复制格式
        destRng.Value = sourceRng.Value
    Next i
    
    Columns("A:A").EntireColumn.Hidden = False
    Application.GoTo Sheets("League Table CSV").Range("A6"), True
    Columns("A:A").EntireColumn.Hidden = True
    
    Application.GoTo Sheets("League Table CSV").Range("B6"), True
End Sub

方案2：使用PasteSpecial粘贴值 #

保留原代码的复制逻辑，修改粘贴步骤为仅粘贴值：

Sub transpLeagueTable()
    Dim targetrow As Long
    Dim i As Long
    
    targetrow = 6
    For i = 8 To ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
        ActiveSheet.Range("A" & i & ":A" & i & ",C" & i & ":J" & i).Copy
        ' 指定仅粘贴值，忽略格式
        Worksheets("League Table CSV").Cells(targetrow, 2 + (i - 8) * 9).PasteSpecial Paste:=xlPasteValues
    Next i
    
    Columns("A:A").EntireColumn.Hidden = False
    Application.GoTo Sheets("League Table CSV").Range("A6"), True
    Columns("A:A").EntireColumn.Hidden = True
    
    Application.CutCopyMode = False
    Application.GoTo Sheets("League Table CSV").Range("B6"), True
End Sub

额外优化说明 #

• 原代码中未声明变量类型，修改后补充了Long类型声明，避免潜在的类型错误；
• 方案1无需调用Application.CutCopyMode = False，因为没有使用剪贴板。

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