如何将工作簿中的某些工作表导入文件夹中的其他工作簿？ (VBA)

Posted 2023-05-06

【中文标题】如何将工作簿中的某些工作表导入文件夹中的其他工作簿？ (VBA)

【英文标题】：How to import certain sheets out of workbooks into an other workbook from a folder? (VBA)

【发布时间】：2016-11-04 10:41:36

【问题描述】：

尊敬的 *** 成员，

过去我在堆栈溢出的帮助下创建了一个动态导入脚本。此脚本从文件夹中的工作簿导入所有工作表。

但现在我只想导入名为“sheet1”的工作表，而不是工作簿中的所有工作表（工作表 1、2 和 3）。

我尝试稍微修改“工作表”变量，但无法使其正常工作。

代码由一个宏脚本和一个函数组成： 这是潜艇

Public Sub Import_sheets_from_dir()
' Import script from http://www.excel-easy.com/vba/examples/import-sheets.html
' Function script from http://***.com/questions/19372319/vba-folder-picker-set-where-to-start
On Error GoTo ErrMsg
Dim directory As String
Dim fileName As String
Dim Sheet As Worksheet
Set ActivoWB = ActiveWorkbook

Application.ScreenUpdating = False
Application.DisplayAlerts = False

directory = GetFolderName() & "/"
fileName = Dir(directory & "*.xl??")

Do While fileName <> ""
    Workbooks.Open (directory & fileName)

    For Each Sheet In Workbooks(fileName).Worksheets
        Workbooks(fileName).Worksheets(Sheet.Name).Copy _
        After:=ActivoWB.Sheets(ActivoWB.Sheets.Count)
    Next Sheet

    Workbooks(fileName).Close
    fileName = Dir()
Loop

Application.ScreenUpdating = True
Application.DisplayAlerts = True

Exit Sub

ErrMsg:
MsgBox prompt:="your doing something wrong"


End Sub

这是使用的函数：

Public Function GetFolderName(Optional OpenAt As String) As String
Dim lCount As Long

GetFolderName = vbNullString

With Application.FileDialog(msoFileDialogFolderPicker)
    .InitialFileName = OpenAt
    .Show
    For lCount = 1 To .SelectedItems.Count
        GetFolderName = .SelectedItems(lCount)
    Next lCount
End With
End Function

我还想知道哪个名称与更改更相关，我想使用 VBA 名称（红色，而不是蓝色（Excel 中显示的工作表名称））。 Print Screen from VBA window 我想了解两者的编码有何不同。

我尝试修改循环For Each Sheet In Workbooks(fileName).Sheet1，但没有成功。

你能指导我正确的方向吗？

提前致谢！

问候， 杜布利

【参考方案1】：

难道不能这么简单：

For Each Sheet In Workbooks(fileName).Worksheets
    If (Sheet.Name = "Sheet1") Then
        Sheet.Copy _
        After:=ActivoWB.Sheets(ActivoWB.Sheets.Count)
    Endif
Next Sheet

【讨论】：

谢谢@Paul Ogilvie 你发布的第二个选项，就像一个魅力！