宏将数据从关闭的工作簿拉到另一个工作簿

Question

我正在编写一个宏来执行以下操作：

每次打开工作簿时，从计算机上已关闭的工作簿中提取数据，然后将该数据复制到从单元格 A1 开始的标题为“可用性”的工作表中。

目前，所发生的一切都是“真”被放入可用性表上的单元格 A1。

请帮忙。

Sub OpenWorkbookToPullData()

    Dim sht As Worksheet
    Dim lastRow As Long
    lastRow = ActiveSheet.UsedRange.Rows.Count
    Set sht = ThisWorkbook.Worksheets(Sheet1.Name)
    Dim path As String
    path = "C:\users\" & Environ$("username") & _
    "\desktop\RC Switch Project\Daily Automation _
    Availability Report.xlsx"

    Dim currentWb As Workbook
    Set currentWb = ThisWorkbook

    Dim openWb As Workbook
    Set openWb = Workbooks.Open(path)

    Dim openWs As Worksheet
    Set openWs = openWb.Sheets("Automation Data")

    currentWb.Sheets("Availability").Range("A1") _
    = openWs.Range("A5:K" & LastRow).Select
    openWb.Close (False)

End Sub

Answer 1

正如@Greg 提到的，.Select 是不需要的。但是，一旦将其删除，您将遇到一个新问题，即两个范围的大小不同。 Range("A1") 仅是 1 个单元格，而其他范围至少为 11 个。您当前的 VBA 只会覆盖所需范围内的值，此处为 A1。

要解决这个问题，有两种效果很好的方法。

调整大小

Resize左侧，使其与右侧大小相同。

Sub OpenWorkbookToPullData()

    Dim sht As Worksheet
    Dim lastRow As Long
    lastRow = ActiveSheet.UsedRange.Rows.Count
    Set sht = ThisWorkbook.Worksheets(Sheet1.Name)
    Dim path As String
    path = "C:\users\" & Environ$("username") & _
    "\desktop\RC Switch Project\Daily Automation Availability Report.xlsx"

    Dim currentWb As Workbook
    Set currentWb = ThisWorkbook

    Dim openWb As Workbook
    Set openWb = Workbooks.Open(path)

    Dim openWs As Worksheet
    Set openWs = openWb.Sheets("Automation Data")

    Dim rng_data As Range
    Set rng_data = openWs.Range("A5:K" & lastRow)

    currentWb.Sheets("Availability").Range("A1").Resize( _
        rng_data.Rows.Count, rng_data.Columns.Count).Value = rng_data.Value

    openWb.Close (False)

End Sub

复制/粘贴特殊

其实是Copy，然后是PasteSpecial。

Sub OpenWorkbookToPullData()

    Dim sht As Worksheet
    Dim lastRow As Long
    lastRow = ActiveSheet.UsedRange.Rows.Count
    Set sht = ThisWorkbook.Worksheets(Sheet1.Name)
    Dim path As String
    path = "C:\users\" & Environ$("username") & _
    "\desktop\RC Switch Project\Daily Automation Availability Report.xlsx"

    Dim currentWb As Workbook
    Set currentWb = ThisWorkbook

    Dim openWb As Workbook
    Set openWb = Workbooks.Open(path)

    Dim openWs As Worksheet
    Set openWs = openWb.Sheets("Automation Data")

    Dim rng_data As Range
    Set rng_data = openWs.Range("A5:K" & lastRow)

    rng_data.Copy
    currentWb.Sheets("Availability").Range("A1").PasteSpecial xlPasteValues

    openWb.Close (False)

End Sub

因为看起来你无论如何都在寻找价值，所以为了代码的清晰，我会使用Copy/PasteSpecial 路由。