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

Question

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

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

目前，所有发生的事情都是“TRUE”被放入可用性表单上的单元格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

复制/ 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路线来清晰起见。