将动态列从一个工作簿复制到另一个工作簿

Question

我有一个数据集，作为估算工时程序的输出，我正在用 VBA 编写以复制列中的值并将它们粘贴到工作簿，我在输入框中定义了他的名字。问题是估计小时输出表上的列中的行数发生了变化，现在我的 VBA 中有硬编码的单元格。我想要做的是创建从单元格 D13 开始的列的动态副本，并将列复制到最后一个值，除非它向上移动 1 个单元格，因为最后一行包含一整行。

下面是我目前的代码

Option Explicit

Sub Copy_Method()

    Dim bookIn As String
    Dim bookOut As String
    Dim X As String

    'Take in data to copy from estimating hours program'
    bookIn = InputBox("Enter workbook name:", "Workbook name")

    'Take in wookbook name to save file to'
    X = InputBox("Set work book name:")


    Workbooks.Add

    'Save new workbook in folder'
    ActiveWorkbook.SaveAs Filename:="C:\Users\BradM\Desktop\RET_DATA_ACTUAL\" & X & ".xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False


    With ActiveWorkbook

    'Insert Tooling'

    'Copy column (What I want to be dynamic, start copy at cell D13 to last row with data, then move up 1 row to account for the total row)'
    Workbooks(bookIn).Worksheets("Production Hours").Range("D13:D45").Copy _

    'PasteSpecial to paste values'
    Workbooks(X).Worksheets("Sheet1").Range("A1").PasteSpecial Paste:=xlPasteValues

    End With

    End Sub

如果还需要什么，请告诉我， 提前致谢。

Answer 1

正如 Sean 在 cmets 中指出的那样，您需要获取最后一行以使其成为动态范围。另一方面，如果您只是在工作表之间传输值，那么最好避免使用复制和粘贴。您可以直接将目标单元格设置为等于源数据，如下所示。

Sub Copy_Method()

    Dim wsInput As Worksheet
    Dim wsOutput As Worksheet

    Dim bookIn As String
    Dim bookOut As String
    Dim lastRow As Long
    Dim X As String

    'Take in data to copy from estimating hours program'
    bookIn = InputBox("Enter workbook name:", "Workbook name")

    'Take in wookbook name to save file to'
    X = InputBox("Set work book name:")

    'Save new workbook in folder'        [Note we have reduced the add and save as into a single line]
    Workbooks.Add.SaveAs Filename:="C:\Users\BradM\Desktop\RET_DATA_ACTUAL\" & X & ".xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    Set wsOutput = ActiveWorkbook.Sheets(1)

    Set wsInput = Application.Workbooks(bookIn).Worksheets("Production Hours")

    'Get last row'      [Note that we subtracted 1 from the lastrow value since you don't want totals]
    lastRow = wsInput.Cells(wsInput.Rows.Count, "D").End(xlUp).Row - 1

    'destination=source
    wsOutput.Range("A1:A" & lastRow - 12) = wsInput.Range("D13:D" & lastRow).value

End Sub

有更优雅和动态的方法来调整上述代码，但这足以证明不使用复制/粘贴（注意，复制/粘贴速度较慢，并且会增加出错的风险）