Excel VBA：从另一个工作簿复制行并粘贴到主工作簿

我在一个文件夹中有许多相同结构的excel文件（Test01，Test02，Test03）。

我在同一文件夹中创build另一个Excel文件，需要从其他Excel文件（结果）中提取信息。

每个testing文件中都有一个特定的列，我需要将其复制并粘贴到结果文件的一行中。

我正尝试创build一个工具或macros，只需按一下button，即可从每个文件中提取相同的列，并将其粘贴到结果文件的新行中。

我不能改变testing文件中的任何东西，这应该会自动完成，而无需打开每个文件。 此外，新的testing文件将被添加到文件夹（Test04，Test05等），所以该function应该能够从新文件拉。

我的代码不运行，而是收到运行时错误：

Private Sub CommandButton1_Click() 'Dim info 'info = isWorkBookopen("C:\Users\Ridwan\Desktop\Test_Excel\Test01.xlsm") 'If info = False Then Workbooks.Open Filename:="C:\Users\Ridwan\Desktop\Test_Excel\Test01.xlsm" 'End If Worksheets(Sheet2).Activate 'This is giving me a runtime error Range("C2:C10").Copy 'Need functions to paste into Results.xlsm End Sub 

在一个侧面说明，我的WorkBookopen函数不起作用，它不认为它是一个函数。 这就是为什么我评论这些线。

Answer 1

因为你说过“这应该是自动完成而不打开每个文件”。 ，你可以试试这个：

 Option Explicit Sub main() Dim fso As New FileSystemObject Dim testFolder As Folder Dim f As File Dim i As Long Set testFolder = fso.GetFolder("C:\Users\Ridwan\Desktop\Test_Excel") With Worksheets("Results") For Each f In testFolder.Files If Left(f.Name, 4) = "Test" Then If fso.GetExtensionName(f.Path) = "xlsm" Then With .Cells(.Rows.Count, 1).End(xlUp).Offset(1) .Value = f.Name i = 0 Do i = i + 1 .Offset(, i).Formula = "='" & testFolder.Path & "\[" & f.Name & "]Sheet1'!C" & i + 1 Loop While .Offset(, i) <> 0 .Offset(, i).ClearContents With Range(.Offset(, 1), .Offset(, 1).End(xlToRight)) .Value = .Value End With End With End If End If Next f End With End Sub 

它需要将“Microsoft脚本运行时”参考添加到您的项目（工具 – >参考，然后向下滚动列表框直到您看到该库，勾选左侧的checkbox并按下“确定”）

Answer 2

尽量使一切都明确

 Private Sub CommandButton1_Click() Dim wbSource as Workbook Dim wbTarget as Workbook Dim shSource as Worksheet Dim shTarget as Worksheet ' Open workbook to copy from as readonly Set wbSource = Workbooks.Open(Filename:="C:\Users\Ridwan\Desktop\Test_Excel\Test01.xlsm", ReadOnly:=true) ' The data is copies to this workbook Set wbTarget = ThisWorkbook ' Did you enclose the worksheet name with double quotes? ' Reference to sheet to copy from set shSource = wbSource.Worksheets("Sheet2") ' Reference to sheet to copy to set shTarget = wbTarget.Worksheets("Sheet to copy to") ' Copy data to first column in target sheet shSource.Range("C2:C10").Copy Destination:= shTarget.Cells(1,1) End Sub 

这样你就不必使用像Activate这样在某些情况下容易出错的语句。

Answer 3

请参阅调用工作表的不同用途：

 Private Sub CommandButton1_Click() Dim wB As Workbook Dim wS As Worksheet Set wB = Workbooks.Open(Filename:="C:\Users\Ridwan\Desktop\Test_Excel\Test01.xlsm") Set wS = wB.Sheets("SheetName") 'Name of the sheet in Excel ''OR 'Set wS = wB.Sheet2 'Name that you'll see in VBE in parenthesis wS.Range("C2:C10").Copy Dim wB2 As Workbook Dim wS2 As Worksheet Dim rG As Range 'if Results.xlsm as already open Set wB2 = Workbooks("Results.xlsm") Set wS2 = wB2.Sheets("Sheet1") Set rG = wS2.Range("B2") rG.Paste End Sub