用于将多张工作表中的范围复制到新工作表中的 VBA

Question

我的目标是从所有选定的工作表中复制以下单元格，将它们转换为每个工作表的单独行，并将它们粘贴到选定工作簿中新创建的工作表中：C4、F3、C3、B2、C5、K3、D21、F4 ，D22：D120

SO 上有几个类似的问题，但没有一个涉及工作表中的多个范围、多个工作表的选择以及转换为每张工作表不同行的表格数据。在一些现有线程和人工智能的帮助下，我设法将这段代码拼凑在一起，但它有几个问题：

1. 它创建的新工作表位于宏源自的工作簿中，而不是位于选定的工作簿中。
2. 它只是复制/粘贴/转换最后选定的工作表。

任何帮助将不胜感激！

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

    ' Create a new worksheet for pasting
    Set TargetSheet = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
    TargetSheet.Name = "PastedValues"
    TargetRow = 1

    ' Set the starting column in the target sheet
    ColumnOffset = 1

    ' Loop through all selected sheets
    For Each selectedSheet In ActiveWindow.SelectedSheets
        ' Create a new row in the target sheet for each sheet's values
        LastRow = TargetSheet.Cells(TargetSheet.Rows.Count, "A").End(xlUp).Row
        TargetRow = LastRow + 1

        ' Copy and paste the specified cells from the selected sheet
        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

        ' Reset column offset for the next sheet
        ColumnOffset = 1
    Next selectedSheet

    ' AutoFit columns in the new worksheet for better visibility
    TargetSheet.Cells.EntireColumn.AutoFit
End Sub

Answer 1

尝试一下。您必须从循环中排除新创建的工作表。

' Loop through all selected sheets
For Each selectedSheet In ThisWorkbook.Sheets

    If selectedSheet.Name <> TargetSheet.Name Then

        ' Create a new row in the target sheet for each sheet's values
        LastRow = TargetSheet.Cells(TargetSheet.Rows.Count, "A").End(xlUp).Row
        TargetRow = LastRow + 1

        ' Copy and paste the specified cells from the selected sheet
        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

        ' Reset column offset for the next sheet
        ColumnOffset = 1
    End If

Next selectedSheet

祝你好运。