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

时间:2016-10-11 06:45:00

标签: excel vba excel-vba

我在一个文件夹(Test01,Test02,Test03)中有许多相同结构的excel文件。

我在同一文件夹中创建了另一个excel文件,需要从其他excel文件中提取信息(结果)。

每个Test文件中都有一个特定的列需要复制并粘贴到Results文件中的一行。

我正在尝试创建一个工具或宏,只需按一下按钮,就可以从每个文件中提取相同的列并将其粘贴到结果文件中的新行中。

我无法改变测试文件中的任何内容,这应该在不打开每个文件的情况下自动完成。此外,新的测试文件将添加到文件夹(Test04,Test05等)中,因此该功能应该能够从新文件中提取。

VBA of Code and Test01 example

Results file

我的代码无法运行,而是收到运行时错误:

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

在旁注中,我的isWorkBookopen函数不起作用,并且它不会将其识别为函数。这就是我评论这些界限的原因。

3 个答案:

答案 0 :(得分:1)

尽量明确一切

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这样的语句,这些语句在某些情况下容易出错。

答案 1 :(得分:1)

查看呼叫表的不同用途:

enter image description here

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

答案 2 :(得分:1)

因为您说"这应该在不打开每个文件的情况下自动完成。" ,您可以试试这个:

table.getRow(0).setCantSplitRow(true);

它需要" Microsoft Scripting Runtime"参考添加到您的项目中(工具 - >参考,然后向下滚动列表框,直到您看到该库,勾选左侧的复选框并按"确定")