【发布时间】:2017-01-27 20:22:46
【问题描述】:
我有一个长度代码,它可以打开一组文件、取消隐藏并导航到特定工作表、复制一个范围并将该范围粘贴到另一个工作簿中。
问题是每当代码打开这些文件时,都会出现一条更新链接的弹出消息。我知道它可以通过 updatelinks = 0 来解决,但是我想知道我应该在我的代码中的哪个位置包含它。
代码也需要时间来执行,所以是否有任何修改可以加快执行速度。
Sub mergeallinputworkbooks()
Dim wkbDest As Workbook
Dim wksDest As Worksheet
Dim wkbSource As Workbook
Dim wksSource As Worksheet
Dim MyPath As String
Dim MyFile As String
Dim FolderName As String
Dim oCell As Range
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
Set wkbDest = ThisWorkbook
Set wksDest = wkbDest.Worksheets("Master Data")
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
.Show
On Error Resume Next
FolderName = .SelectedItems(1)
Err.Clear
On Error GoTo 0
End With
MyPath = FolderName
If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\"
MyFile = Dir(MyPath & "*.xls")
Do While Len(MyFile) > 0
Set wkbSource = Workbooks.Open(MyPath & MyFile)
Set wksSource = wkbSource.Worksheets("Scoring DB")
ActiveWorkbook.Unprotect ("pyroo123")
Sheets("Scoring DB").Visible = True
Sheets("Scoring DB").Select
Range("A4:W4").Copy
Windows("Performance Dashboard.xlsm").Activate
With Sheets("Master Data").Range("$A:$A")
With Sheets("Master Data")
Set oCell = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0)
End With
oCell.Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Windows("Performance Dashboard.xlsm").Activate
End With
wkbSource.Close savechanges:=False
MyFile = Dir
Loop
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
End Sub
【问题讨论】: