Excel 2016 VBA：如何在转置数据左侧添加单元格

看起来你想把A列中每7行一组的第一个单元格内容，放到转置后数据的左侧（J列），但当前用Select+Copy/Paste的方式不仅效率低，还容易因为工作表激活状态、用户误操作等导致出错。我来给你优化一下代码，解决这个问题：

首先，先说说你当前代码的问题：Select和Selection这类操作是模拟用户手动点击的行为，在VBA里不仅运行慢，还非常不稳定——比如如果代码运行时你切换了其他工作表，ActiveSheet.Paste就会把内容粘到错误的地方。我们可以直接操作单元格对象，跳过这些交互步骤。

下面是优化后的代码：

Sub TransposeRows2()
    Dim i&, z&, x&
    i = Cells(Rows.Count, "D").End(xlUp).Row
    z = 1: x = 1
    
    ' 关闭屏幕更新和事件，提升运行速度并避免干扰
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    ' 错误处理，确保即使出错也能恢复Excel设置
    On Error GoTo Cleanup
    
    While z <= i
        ' 直接赋值，替代Copy/Paste，高效又稳定
        Range("J" & x).Value = Range("A" & z).Value
        
        ' 转置D列开始的7行数据到K列的7个单元格中
        Range("K" & x).Resize(, 7).Value = WorksheetFunction.Transpose(Range("D" & z).Resize(7))
        
        z = z + 7
        x = x + 1
    Wend
    
Cleanup:
    ' 恢复Excel的默认设置
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    ' 如果有错误，弹出提示
    If Err.Number <> 0 Then
        MsgBox "代码运行出错：" & Err.Description, vbExclamation
    End If
End Sub

几个关键优化点： #

• 直接赋值替代复制粘贴：用Range("J" & x).Value = Range("A" & z).Value直接把A列单元格的值传给J列，完全不需要经过剪贴板，速度快了不止一点，也不会因为选择操作出问题。
• 添加性能优化：关闭ScreenUpdating可以避免代码运行时屏幕闪烁，关闭EnableEvents可以防止触发工作表的事件（比如Change事件）干扰代码运行。
• 错误处理：通过On Error GoTo Cleanup确保即使代码出错，也能恢复Excel的正常设置，不会让屏幕一直处于不更新的状态。

如果你的A列单元格有格式（比如字体、颜色、边框）需要一起复制，那可以改成这种写法，同样不用Select：

Range("A" & z).Copy Range("J" & x)

这样会把格式和内容一起复制过去，比手动选择粘贴要靠谱得多。

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