vba - Excel VBA : Copy Row from another workbook and paste into master workbook

Question

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

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

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

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

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





我的代码没有运行，而是收到运行时错误:

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 函数不起作用，并且它不将其识别为函数。这就是我评论这些行的原因。

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 Scripting Runtime”引用添加到您的项目中(工具 -> 引用，然后向下滚动列表框直到看到该库，勾选其左侧的复选框并按“确定”)