更新链接提示问题

时间:2016-09-20 03:10:49

标签: vba excel-vba excel

我有一个长度代码,用于打开一组文件,取消隐藏并导航到特定工作表,复制范围并将该范围粘贴到另一个工作簿中。

问题是,只要代码打开这些文件,就会出现一条弹出消息来更新链接。我知道它可以通过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

1 个答案:

答案 0 :(得分:0)

对于链接问题,have a look at this post。应该有足够的信息可以很好地说明如何以及在何处使用链接更新。

现在代码建议
为了提高代码的性能,我建议不要在没有必要的情况下与工作表进行交互。而不是“复制和过去”将范围分配给数组:

arrMyRange = Worksheets("SourceWorksheet").Range("A4:W4")

这将创建您的阵列。现在将阵列分配到您的位置:

Worksheets("DestinationWorksheet").Range("A1").Resize(UBound(arrMyRange, 1), UBound(arrMyRange, 2)).Value = arrMyRange 
如果需要,可以动态更改

A1