根据单元格值将一系列单元格向下复制指定次数

Question

我正在尝试根据单元格值将一系列单元格向下复制指定次数，并从活动单元格的交叉点开始。

我仔细阅读了 Stack Overflow 问题的页面。

带有用户表单信息的整个子。

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

得到

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

我正在为资产组合制定摊销时间表。处置时，我需要修改新资产 cost/rental 付款的摊销时间表，并以两种不同的比率对其进行跟踪。由他们输入更新的资产信息的用户表单发起。

我可以运行原始摊销时间表代码，但我需要后续的部分处置是动态的，因为投资组合可能有数百种资产。（先不说效率有多低，因为客户永远是对的，目前我都是复制粘贴的。）

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

根据单元格值将一系列单元格向下复制指定次数

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

excel

vba

excel-2016