VBA多工作表指定单元格区域复制到新表问题求助

问题分析 #

1. 新建工作表位置错误：原代码使用ThisWorkbook（宏所在工作簿）创建新表，不符合需求中“在选中工作表所属的目标工作簿内新建”的要求。
2. 循环逻辑冗余导致异常：原代码中TargetRow的计算存在重复判断，且未考虑新建表的初始状态，可能导致数据覆盖或仅处理最后一个工作表的情况。

修正后的代码 #

Sub CopyPasteBudgetExpenses()
    Dim TargetWB As Workbook
    Dim TargetSheet As Worksheet
    Dim selectedSheet As Worksheet
    Dim ColumnOffset As Long
    Dim TargetRow As Long
    Dim SourceRange As Range
    Dim cell As Range

    ' 校验是否选中工作表
    If ActiveWindow.SelectedSheets.Count = 0 Then
        MsgBox "请先选中需要处理的工作表！", vbExclamation
        Exit Sub
    End If

    ' 获取选中工作表所属的目标工作簿
    Set TargetWB = ActiveWindow.SelectedSheets(1).Parent

    ' 在目标工作簿创建新表（处理同名表冲突）
    On Error Resume Next
    Set TargetSheet = TargetWB.Sheets("PastedValues")
    If Err.Number <> 0 Then
        Set TargetSheet = TargetWB.Sheets.Add(After:=TargetWB.Sheets(TargetWB.Sheets.Count))
        TargetSheet.Name = "PastedValues"
    End If
    On Error GoTo 0

    ' 初始化目标起始行：空表从第1行开始，非空表从最后一行下一行开始
    TargetRow = TargetSheet.Cells(TargetSheet.Rows.Count, "A").End(xlUp).Row
    If TargetRow = 1 And TargetSheet.Cells(1, 1).Value = "" Then
        TargetRow = 1
    Else
        TargetRow = TargetRow + 1
    End If

    ' 遍历所有选中工作表
    For Each selectedSheet In ActiveWindow.SelectedSheets
        ' 跳过新建的目标表，避免重复处理
        If selectedSheet.Name <> "PastedValues" Then
            ColumnOffset = 1
            ' 定义需要复制的单元格区域
            Set SourceRange = selectedSheet.Range("C4, F3, C3, B2, C5, K3, D21, F4, D22:D120")

            ' 将单元格值逐列写入目标行
            For Each cell In SourceRange
                TargetSheet.Cells(TargetRow, ColumnOffset).Value = cell.Value
                ColumnOffset = ColumnOffset + 1
            Next cell

            ' 目标行下移，准备下一个工作表的数据
            TargetRow = TargetRow + 1
        End If
    Next selectedSheet

    ' 自动调整列宽
    TargetSheet.Cells.EntireColumn.AutoFit
End Sub

关键修改说明 #

• 目标工作簿定位：通过ActiveWindow.SelectedSheets(1).Parent获取选中工作表所属的工作簿，替代原代码的ThisWorkbook，确保新表创建在正确位置。
• 同名表冲突处理：添加错误捕获逻辑，若目标工作簿已存在PastedValues表则直接使用，避免创建时报错。
• 目标行初始化优化：判断新表是否为空，正确设置起始行，避免空表时跳过第一行数据。
• 循环逻辑简化：将ColumnOffset初始化移至循环内部，确保每个工作表都从第一列开始写入；处理完一个工作表后直接下移目标行，减少冗余计算。
• 排除目标表：在循环中跳过新建的PastedValues表，防止误处理自身。

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