|
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
- Sub 程序放在人员文件夹外()
- Dim w As Workbook, sh As Worksheet, MyPath As String, MyName As String
- Application.ScreenUpdating = False
- Set d = CreateObject("scripting.dictionary")
- For Each sh In Sheets
- d(sh.Name) = ""
- sh.Cells.ClearComments
- Next
- MyPath = ThisWorkbook.Path & "\人员"
- MyName = Dir(MyPath & "*.xlsx")
- Do While MyName <> ""
- If MyName <> ThisWorkbook.Name Then
- With ThisWorkbook
- Set w = CreateObject(MyPath & "" & MyName)
- For Each sh In w.Worksheets
- If d.Exists(sh.Name) Then _
- sh.Range("B8:D10").Copy .Worksheets(sh.Name).[a65536].End(3)(1, 1)
- Next
- Windows(w.Name).Visible = True
- w.Close False
- End With
- End If
- MyName = Dir
- Loop
- Set d = Nothing
- Set w = Nothing
- ActiveWorkbook.RemovePersonalInformation = False
- Application.ScreenUpdating = True
- MsgBox "数据处理完毕。"
- End Sub
复制代码 |
|