0

I have a length code which opens set of files, unhides and navigates to a particular worksheet, copies a range and pastes that range in another workbook.

The problem is whenever the code opens these files a popup message to update links appears. I understand it can be solved with updatelinks = 0 however wanted to know where should i include this in my code.

Also the code takes time to execute, so is there any modifications for faster execution.

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
Community
  • 1
  • 1

1 Answers1

0

For you links issue, have a look at this post. There should be enough information there to give you a good indication of how and where to use the link update.

Now code suggestion:
To improve performance of your code, I would suggest not to interact with worksheet where not necessary. Rather than 'Copy and Past' assign the range to an array:

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

This will create your array. Now assign the array to your location:

Worksheets("DestinationWorksheet").Range("A1").Resize(UBound(arrMyRange, 1), UBound(arrMyRange, 2)).Value = arrMyRange 

A1 can be changed dynamically if required.

Community
  • 1
  • 1
Zac
  • 1,924
  • 1
  • 8
  • 21