将数据从关闭的工作簿提取到另一个工作簿的宏
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
路线。
我正在编写一个宏来执行以下操作:
每次我打开工作簿时,从计算机上关闭的工作簿中提取数据并将该数据复制到 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
路线。