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

Macro to pull data from closed workbook to another workbook

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

每次我打开工作簿时,从计算机上关闭的工作簿中提取数据并将该数据复制到 sheet 标题为 "Availability" 从单元格 A1 开始。

目前,所有发生的事情是 "TRUE" 被放入可用性 sheet 的单元格 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

正如@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

实际上 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 路线。