Excel VBA设置TargetCell =基于单元格值的动态参数范围

Question

我正在尝试根据单元格值向下复制指定范围的单元格范围，并从活动单元格的交点开始。

我一遍又一遍地浏览了堆栈溢出问题，但是没有什么解决方案可以帮助我。

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

VBA：获取运行时1004：对象'_Worksheet'的方法'Range'失败

已更新以添加图片，还使用用户表单信息更新了整个Sub

我正在为资产组合建立摊销时间表。处置时，我需要修改新资产成本/租金支付的摊销时间表，并以两种不同的汇率进行跟踪。由用户表单发起，他们输入更新的资产信息。

我可以很好地运行原始的amort计划代码，但是我需要随后的部分处置是动态的，因为投资组合可能具有数百个资产。 （我们不要说效率低下是因为客户总是对的，目前我正在通过复制和粘贴来实现它……）

Answer 1

我已经根据您到目前为止描述的内容以及您的代码已经在做什么进行了一些假设。请让我知道它是否可以按您的需要工作，或者让我知道，我可以提供进一步的帮助。

查看代码中的更多注释：

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