Copy a range of cells down a specified number of times based on a cell value

Question

I'm trying to copy a range of cells down a specified number of times based on a cell value, and starting at the intersection of the active cell.

I've pored through pages of Stack Overflow issues.

Entire Sub with userform info.

Private Sub OKButton_Click()

Dim AppTab As String
Dim DDate As Date
Dim Rent As Long
Dim ActiveCost As Long
Dim Msg As String

AppTab = Application.Value
DDate = DispoDate.Value
Rent = RentPymt.Value
ActiveCost = Cost.Value
Msg = "Asset disposal date:"

Sheets(AppTab).Select

Range("A6:N11").Select
Selection.copy
Range("A9").Select
Selection.End(xlToRight).Offset(-3, 1).Select
ActiveSheet.Paste

ActiveCell.Offset(-5, 0).Select
ActiveCell.Value = Msg
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = DDate
ActiveCell.Offset(8, 5).Select
ActiveCell.Value = ActiveCost
ActiveCell.Offset(1, -5).Activate

Dim DataEntry As Worksheet, DataSht As Worksheet
Dim ItemName As Range, ItemCount As Range
Dim NRow As Long, TargetCell As Range

With ThisWorkbook
    Set DataEntry = .ActiveSheet
    Set DataSht = .ActiveSheet
End With

With DataEntry
    Set ItemName = .Range("A11")
    Set ItemCount = .Range("H3")
End With

NCol = ActiveCell.Column

With DataSht
    NRow = .Range("A" & Rows.Count).End(xlUp).Row + 1
    'Set TargetCell = .Range("A" & NRow) 'This works
    Set TargetCell = .Cells(NRow, NCol) 'Issue here
    TargetCell.Resize(ItemCount.Value, 1).Value = ItemName.Value
End With

Range(Selection, Selection.End(xlToRight)).Select
Selection.copy
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Paste

Unload Me
End Sub

Getting

run-time 1004: Method 'Range' of object '_Worksheet'failed

I'm building amortization schedules for a portfolio of assets. When one disposes, I need to modify the amortization schedule for the new asset cost/rental payment, and track it at two different rates. Initiated by a userform where they enter the updated asset info.

I can run the original amortization schedule code, but I need the subsequent partial disposals to be dynamic as the portfolio could have hundreds of assets. (Let's not talk about how inefficient that is because the customer is always right and currently I'm doing it by copying and pasting.)

Answer 1

I've made some assumptions based on what you described so far, and what your code was doing already. Please let me know if it works as you need, or let me know and I can assist further.

See more comments in the code:

Private Sub OKButton_Click()

Dim AppTab As String
Dim DDate As String
Dim Rent As String 'this is never used
Dim ActiveCost As String
Dim Msg As String

AppTab = Application.Value 'This doesn't look quite right, it would return "Microsoft Excel" ... is that your sheet name?
DDate = DispoDate.Value
Rent = RentPymt.Value 'this is never used
ActiveCost = Cost.Value
Msg = "Asset disposal date:"

Dim DataEntry As Worksheet: Set DataEntry = ThisWorkbook.Sheets(AppTab) 'declare and set the worksheet to use - change as needed
Dim rngCopy As Range: Set rngCopy = DataEntry.Range("A6:N11") 'Set the range to copy - this could be determined more dynamically

Dim ItemCount As Long: ItemCount = DataEntry.Range("H3").Value 'set the number of rows to copy

    With rngCopy
        .Copy _
            Destination:=.Offset(, .Columns.Count) 'Copy ("A6:N11") to ("O6:AB11")

        .Offset(.Rows.Count - 1).Resize(1, .Columns.Count).Copy _
            Destination:=.Offset(.Rows.Count, .Columns.Count).Resize(ItemCount, .Columns.Count) 'Copy the last line from above, to the number of the rows in ItemCount
    End With

    'Is not a good idea to use ActiveCell... better use a fixed range, or build some rules to determine your "active" cell (i.e.: use Find).
    Dim rngActCell As Range: Set rngActCell = DataEntry.Range("P6") 'but if you insist in using ActiveCell, then use: Set rngActCell = Activecell

    'Other details
    With rngActCell
        .Offset(-5, 0).Value = Msg 'P1
        .Offset(-4, 0).Value = DDate 'P2
        .Offset(4, 5).Value = ActiveCost 'U10
    End With

Unload Me
End Sub