从多个工作簿复制特定工作表而不打开工作簿

Question

我在下面有一个代码，它可以从所有活动或打开的工作簿中复制特定的工作表。

但是如何在不打开工作簿的情况下复制同一个工作表，就像我们可以在代码中提供路径一样，它应该能够从该路径的所有工作簿中选择给定的工作表。

下面是当前正在使用的代码。

Sub CopySheets1()
    Dim wkb As Workbook
    Dim sWksName As String

    sWksName = "SHEET NAME"

    For Each wkb In Workbooks
        If wkb.Name <> ThisWorkbook.Name Then
            wkb.Worksheets(sWksName).Copy _
            Before:=ThisWorkbook.Sheets(1)
        End If
    Next

    Set wkb = Nothing
 End Sub

Answer 1

使用 Workbooks.Open Method 在后台打开它，并使用 Application / ScreenUpdating / EnableEvents / DisplayAlerts 隐藏任何警报

---

_{Application.ScreenUpdating Property (Excel) 关闭屏幕更新以加快您的宏代码。您将无法看到宏在做什么，但它会运行得更快。}

---

例子

Sub CopySheets1()
    Dim wkb As Workbook
    Dim sWksName As String

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .DisplayAlerts = False
    End With

    wkb Workbooks.Open("C:\temp\bookname.xls")

    sWksName = "SHEET NAME"

    For Each wkb In Workbooks
        wkb.Worksheets(sWksName).Copy _
        Before:=ThisWorkbook.Sheets(1)
    Next

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .DisplayAlerts = True
    End With

    Set wkb = Nothing
 End Sub

---

假设您的文件夹名称是 C:\Temp\，然后循环直到文件夹返回空

---

例子

    Dim FileName As String
    ' Modify this folder path as needed
    FolderPath = "C:\Temp\"
    ' Call Dir the first time to all Excel files in path.
    FileName = Dir(FolderPath & "*.xl*")

    ' Loop until Dir returns an empty .
    Do While FileName <> ""
        ' Open a workbook in the folder
        Set wkb = Workbooks.Open(FolderPath & FileName)

        '--->> Do your copy here

        ' Close the source workbook without saving changes.
        wkb.Close savechanges:=False

        ' next file name.
        FileName = Dir()
    Loop

_{如果您想无限次重复一组语句，直到满足某个条件，请使用Do...Loop 结构。如果您想重复语句一定次数，For...Next Statement 通常是更好的选择。}

Answer 2

我假设您不想向用户显示打开的工作簿，因此该操作在屏幕上不可见。

如果是这种情况，您可以在代码之前使用以下行

  Application.ScreenUpdating = False

  'open the new/target excel workbook and put all the sheets in there

之后：

  Application.ScreenUpdating = True

Answer 3

看来您必须手动打开工作簿。您可以按如下方式在 VBA 中自动执行此过程；

Sub CopySheets1()
Dim wkb As Workbook
Dim dirPath As String ' Path to the directory with workbooks
dim wkbName as String

dirPath="C:\folder\"

sWksName = "SHEET NAME"

wkbName=Dir(dirPath & "*.xlsx") 

例如： dirPath = "C:\文件夹\" 这样 Dir 函数的输入就像 "C:\folder*.xlsx"

Application.DisplayAlerts = False
do while wkbName <> ""
    Set wkb=Application.Workbooks.Open(dirPath & wkbName)
            wkb.Worksheets(sWksName).Copy _
            Before:=ThisWorkbook.Sheets(1)
    wk.Close False
    wkbName = Dir
loop
Application.DisplayAlerts = True


End Sub