excel - Attempting to copy most recent non-contiguous cells in a range, and paste into a contiguous range on another worksheet in same workbook

Question

I'm new to using VBA, and have been trying to consult articles, however; I still have an issue.

I'm building out a project tracker for my team, with a high level overview on the first sheet, and then for each Project there is an associated sheet that contains a detailed tracker. (i.e. Project 1, Project 2, Project 3 show as rows in the first sheet, and then Project 1 has it's own sheet, Project 2 has it's own sheet, etc.)

I am trying to automate updates to this tracker, as each time a new row is added to the high level tracker, I want to copy specific non contiguous cells and paste the values in the associated sheet.

My first attempt was to be able to complete this task for the first project in the tracker, and then I'll add subsequent macros later after I adjust the code. However, when I run the following macro there are no errors but there are no outputs into the specified destination.

Some other things to note:

• For high level tracking file, Project 1 goes from cells A9:A10, Project 2 goes from cells A13:A18, and so on.. they are one on top of the other
• An issue in my current code is also that I am specifically calling out cells to create an array with. I would imagine that once I successfully run this, for the next added project task, I would have to manually adjust these call outs. Any advice to circumvent that would also be appreciated..

The following is my code

Sub Update_Project_1()
Dim LR As Long, i As Long, cls
Dim wscopy As Worksheet
Dim wspaste As Worksheet


Set wscopy = Workbooks("Project_Tracker.xlsm").Worksheets("High Level Tracker")
Set wspaste = Workbooks("Project_Tracker.xlsm").Worksheets(" Project 1 Detailed Tracker")
With wscopy
    cls = Array("A10", "B10", "C10", "F10", "H10")
End With

With wspaste
    LR = WorksheetFunction.Max(4, .Range("A" & Rows.Count).End(xlUp).Row + 1)
    Debug.Print LR
    
    For i = LBound(cls) To UBound(cls)
        .Cells(LR, i + 1).Value = wspaste.Range(cls(i)).Value
    Next i
End With

End Sub

Any advice would be greatly appreciated, thanks in advance!

question from:https://stackoverflow.com/questions/65894146/attempting-to-copy-most-recent-non-contiguous-cells-in-a-range-and-paste-into-a

Answer 1

This should get you started.

• Set a reference to source and target sheet
• Define the source range of cells
• Get last row in target sheet
• Loop through each source cell
• Output values in target sheet (next empty cell)

Notes:

• Check the column A where I get the last row (lastRow = targetSheet.Cells(targetSheet.Rows.Count, "A").End(xlUp).Row)
• Look how I referenced the output column (A in this line: targetSheet.Range("A" & lastRow + 1)) and then I moved with the column counter

---

Public Sub Update_Project_1()

    ' Set a reference to the source sheet
    Dim sourceSheet As Worksheet
    Set sourceSheet = ThisWorkbook.Worksheets("High Level Tracker")
    
    ' Set a reference to the target sheet
    Dim targetSheet As Worksheet
    Set targetSheet = ThisWorkbook.Worksheets("Project 1 Detailed Tracker")

    ' Set a reference to the source range
    Dim sourceRange As Range
    Set sourceRange = sourceSheet.Range("A10,B10,C10,F10,H10")

    ' Get last row in target sheet
    Dim lastRow As Long
    lastRow = targetSheet.Cells(targetSheet.Rows.Count, "A").End(xlUp).Row

    ' Loop through each cell in source range
    Dim sourceCell As Range
    For Each sourceCell In sourceRange.Cells
        ' Output values from source range into next empty row in target
        Dim columnCounter As Long
        targetSheet.Range("A" & lastRow + 1).Offset(, columnCounter).Value = sourceCell.Value
        columnCounter = columnCounter + 1
    Next sourceCell

End Sub

Let me know if it works