Excel VBA实现多工作表数据复制粘贴（排除Sheet2+避免覆盖）

你的代码存在两个核心问题：一是未排除指定的Sheet2，二是每次固定粘贴到E1列导致数据被覆盖。以下是修正后的方案：

修改后的代码 #

Public Sub DoToAll()
    Dim ws As Worksheet
    Dim targetCol As Long ' 记录每次粘贴的目标列
    
    ' 初始化目标列：从E列（第5列）开始
    targetCol = 5
    
    For Each ws In Worksheets
        ' 跳过指定的Sheet2
        If ws.Name <> "Sheet2" Then
            ' 复制当前工作表的A3:A300区域
            ws.Range("A3:A300").Copy
            ' 转置粘贴到Sheet2的目标列第1行位置
            Worksheets("Sheet2").Cells(1, targetCol).PasteSpecial Transpose:=True
            ' 目标列后移一列，避免下次覆盖
            targetCol = targetCol + 1
        End If
    Next ws
    
    ' 清除剪贴板，结束复制状态
    Application.CutCopyMode = False
End Sub

关键修改说明 #

• 排除指定工作表：通过If ws.Name <> "Sheet2" Then判断，循环时直接跳过Sheet2
• 避免数据覆盖：用targetCol变量动态记录粘贴列位置，每次粘贴后列数+1，确保下一份数据自动移到下一列
• 细节优化：添加Application.CutCopyMode = False清除剪贴板，避免Excel一直保留复制状态

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