复制其他Excel文件的sheet到本Excel文件中来

在.xlsm文件中打开Visual Basic编辑器，在文本编辑器中输入以下VBA程序，实现复制sheet功能。

Private Sub all2here_Click()    '其他sheet表复制到此Excel中
    MsgBox "欢迎开始载入……"
    Dim wb, arr, Sh As Worksheet, pic As Shape
    Application.ScreenUpdating = False

     '1号库A班
     Path = Application.ThisWorkbook.Path    '相对路径
     Set wb = Workbooks.Open(Filename:=Path & "\自营考勤8月份\1号库A班\" & "1号库A班.xlsx", UpdateLinks:=0)
       For Each Sh In wb.Worksheets
          If Sh.Name = "员工考勤表" Then
                Sheets("员工考勤表").Copy after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)   '复制年休假明细表；
                ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name = "1号库A班考勤合同"
            End If
        Next
     wb.Close False

   Application.ScreenUpdating = True
   MsgBox "载入完成结束！"
End Sub

MsgBox 那行会显示一个提示文本框。

Application.ScreenUpdating 开头和结束各一行，表示暂时关闭屏闪，不用一直刷新，最后再打开这个功能。

此次在复制.xlsx文档时，采用相对路径的方式，将操作的.xlsm文件和自营考勤8月份文件夹放在一个文件夹目录下，这样在整体拷贝这些文件时，上一级文件夹不论在什么位置，都可以寻到1号库A班.xlsx文件。open函数有很多参数，具体使用自行搜索，这里UpdateLinks:=0代表打开的文件“默认不提示更新链接”。

如果使用绝对引用，如上一级目录在D盘的fantish文件夹下，则可以将这两行用如下一行代替：

 Set wb = Workbooks.Open(Filename:="D:\fantish\自营考勤8月份\1号库A班\" & "1号库A班.xlsx", UpdateLinks:=0)

 If和End If语句之间，是复制sheet的程序，如果有满足名称为“员工考勤表”的sheet，则复制过来并放在现有sheet表的最后，最后再修改复制过来的sheet表的名称。

这样就将某一个sheet复制过来，最后wb.Close False 关闭打开的源Excel文件，False代表不保存源Excel文件（如果有修改），True则为保存。