macros将数据从closures的工作簿拉到另一个工作簿

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

每当我打开一个工作簿时，从计算机上closures的工作簿中提取数据，并将这些数据复制到一个名为“可用性”的单元格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")只有一个单元格，而另一个范围至less为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路线清晰的代码。