Question

我有以下代码，允许我选择一个文件并从中导入“笔”选项卡，但是我想选择多个文件。

我希望能够从统一工作簿中自己的选项卡上的多个工作簿中选择“笔”选项卡。

请问你能帮忙解决这个问题吗？我认为这可能需要使用For Each功能，但不确定如何构建它。

非常感谢

Sub ImportActiveList()
    Dim FileName As String
    Dim WS1 As Worksheet
    Dim WS2 As Worksheet
    Dim ActiveListWB As Workbook

    Set WS2 = ActiveWorkbook.Sheets("AllPens")
    FileName = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls*),*.xls*", _
                                           Title:="Select Active List to Import", _
                                           MultiSelect:=False)

    If FileName = "False" Then
        Exit Sub
    Else
        Set ActiveListWB = Workbooks.Open(FileName)
    End If

    Set WS1 = ActiveListWB.Sheets("Pens")

    WS1.UsedRange.Copy WS2.Range("A1")

    ActiveWorkbook.Close False

End Sub

Answer 1

如果您有一个集合或要迭代的对象或值数组，则需要For Each循环。有关其用法的语法和示例，请参阅文档。

如果更改MultiSelect的{{1}}参数，则用户可以从同一目录中选择多个文件。返回值是包含所有这些文件的集合。然后你可以像这样迭代它：

GetOpenFilename()

还应注意以下事项：

Public Sub ImportActiveList() Dim FileNames As Variant Dim FileName As Variant Dim WSNew As Worksheet Dim ActiveListWB As Workbook ' ask the user for the files to copy the data from FileNames = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls*),*.xls*", _ Title:="Select Active List to Import", _ MultiSelect:=True) If VarType(FileNames) = vbBoolean Then If Not FileNames Then Exit Sub End If ' loop over all files selected by the user and import the desired sheets For Each FileName In FileNames ' create new worksheet to copy the data to ' here you could add a name for the sheet or make sure it is at the right position Set WSNew = ActiveWorkbook.Sheets.Add ' copy the data Set ActiveListWB = Workbooks.Open(FileName) ActiveListWB.Sheets("Pens").UsedRange.Copy WSNew.Range("A1") ActiveListWB.Close False Next FileName End Sub仅适用于英语Excel安装，因为其他语言具有FileName = "False"的其他文字。你也无法打开一个名为＆＃34; False＆＃34;的文件。因为你无法区分中止文件对话框的文件名和返回值（在大多数情况下，这确实是一个问题，但是......）。您将类型为False的返回值保存在Variant类型的变量中。如果您将其更改为String，则可以测试内容是否为子类型Variant，以及该布尔值是否为Boolean。这将避免上述所有问题。
False关闭当前工作簿 - 这大多数时候是刚刚打开以复制数据的工作簿。但假设您暂停代码，切换到整合的工作簿并继续代码：然后活动工作簿现在是此工作簿，它将被关闭 - 无需提示保存！
您真正想要的是关闭刚刚打开的工作簿，因此我将ActiveWorkbook.Close替换为ActiveWorkbook。

Answer 2

我有一个可能有用的宏。将其转化为您的愿望：

Sub agrupar()

Application.EnableCancelKey = xlDisabled
Application.ScreenUpdating = False

ruta = Application.ActiveWorkbook.Path
miarchivo = ThisWorkbook.Name
nombrepestaña = ActiveSheet.Name

ChDrive ruta
ChDir ruta

archi = Dir("*.xl*")

Do While archi <> ""

If archi <> miarchivo Then
Workbooks.Open archi, UpdateLinks:=0, ReadOnly:=True
For Each Sheet In ActiveWorkbook.Sheets
Sheet.Copy after:=ThisWorkbook.ActiveSheet
Next Sheet
Workbooks(archi).Close False
End If

archi = Dir()
Loop

Sheets(nombrepestaña).Select

Application.ScreenUpdating = True

End Sub

VBA将多个工作表导入Workbook

2 个答案: