VBA 将多张工作表导入工作簿答案

【问题标题】：VBA Import multiple sheets into WorkbookVBA 将多张工作表导入工作簿
【发布时间】：2016-05-05 10:17:27
【问题描述】：

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

我希望能够从多个工作簿中选择“笔”选项卡，每个工作簿都位于合并工作簿中自己的选项卡上。

请您帮忙看看这可能如何运作？我认为这可能需要使用 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

【问题讨论】：

标签： vba excel

【解决方案1】：

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

如果您将MultiSelect 参数更改为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

还应注意以下几点：

FileName = "False" 只能在英文 Excel 安装中工作，因为其他语言对于 False 有其他文字。此外，您将无法打开刚刚命名为“False”的文件，因为您无法区分文件名和中止文件对话框的返回值（尽管在大多数情况下，这不会是一个真正的问题......） .
将Variant 类型的返回值保存在String 类型的变量中。如果您也将其更改为Variant，您可以测试内容是否为子类型Boolean，以及该布尔值是否为False。这将避免上述所有问题。
ActiveWorkbook.Close 关闭当前工作簿 - 大多数时候是刚刚打开以从中复制数据的工作簿。但假设您暂停代码，切换到合并的工作簿并继续执行代码：那么活动工作簿现在就是这个工作簿，它将被关闭 - 没有提示保存！
您真正想要的是关闭您刚刚打开的工作簿，所以我将ActiveWorkbook 替换为ActiveListWB。

【讨论】：

您好，谢谢，但我在 If VarType(FileName) = vbBoolean And Not FileName Then 收到调试错误
非常感谢。我唯一要改变的是，不要不断地要求用户为数据选择一个文件，而是允许他们一次选择多个文件。这可能吗，因为它会节省很多时间，特别是如果有很多时间。
再次更新。如果您需要用户从多个目录中选择文件，您必须为每个目录显示一个文件打开对话框。为此，您可以在我编辑之前使用之前的代码（单击答案下方的“edited”链接）。
非常感谢您的帮助。还有一个问题....如何调整代码以便将选项卡重命名为与文件相同的名称？
使用工作表.Name 属性。如果您为 Sheets.Add 提供附加参数，则在创建过程中可能会影响工作表的顺序

【解决方案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

【讨论】：