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

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

如果是这种情况，您可以在代码

之前使用以下行

var result = myAPICall() + "";

继之后：

  Application.ScreenUpdating = False

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

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：\ folder \” 这样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

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

3 个答案: