How to copy most recent non-contiguous cells in a range into a contiguous range on another worksheet?

user_14968676 0
Viewed 53

I'm building a project tracker, with a high level overview on the first sheet, and then for each Project an associated sheet that contains a details. (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. Each time a 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 complete this task for the first project in the tracker. 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 code is that I call out specific cells to create an array. I would imagine that for the next project I would have to manually adjust these call outs. Any advice to circumvent that?
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
vba excel
1 Answers

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

user_15215790
Related