2016-09-20 48 views
0

我有一個打開一組文件,取消隱藏和導航到特定工作表的長度代碼,複製範圍並將該範圍粘貼到另一個工作簿中。更新鏈接提示問題

問題是每當代碼打開這些文件彈出消息更新鏈接出現。我知道它可以通過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 

回答

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如果需要,可以動態地改變。

+0

請告訴它應該包含在哪裏。如有可能,請修改代碼 –