VBA for Copying Ranges from Multiple Sheets Into a New One

Question

My goal is to copy the following cells from all selected sheets, transform them into individual rows per sheet, and paste them into a newly created sheet within the selected workbook: C4, F3, C3, B2, C5, K3, D21, F4, D22:D120

There are several similar question on SO, but none deal with multiple ranges within a sheet, the selection of multiple sheets, and the transformation into tabular data with a different row per sheet. With the help of some existing threads and AI, I managed to cobble this code together, but it has several issues:

1. The new sheet it creates is in the workbook that the macro originates from, rather than the selected workbook.
2. It is only copy/paste/transforming the last selected sheet.

Any help would be much appreciated!

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

Try. You must exclude the newly created worksheet from the loop.

' 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

Good luck.