Running VBA script causes excel to stop responding

Question

I have a VBA script that adds sheets to around 500 excel files. I had no problems running the VBA script and adding simple sheets, but when I try to add a sheet with VBA script in it and graphs and buttons, it works for a while and than freezes.

Here is the code. I know it does not have error handling - any suggestions how to tackle this problem or maybe what is causing excel to freeze?

Sub FindOpenFiles()

Const ForReading = 1
Set oFSO = New FileSystemObject

Dim txtStream As TextStream

Dim FSO As Scripting.FileSystemObject, folder As Scripting.folder, file As Scripting.file, wb As Workbook, sh As Worksheet
Dim directory As String

'The path for the equipement list. - add the desired path for all equipement or desired value stream only.
Set txtStream = oFSO.OpenTextFile("O:\SiteServices\Maintenance\Maintenance Support Folder\Maintenance Department Information\HTML for Knowledgebase\Excel for Knowledgebase\Equipement paths-all.txt", ForReading)

Do Until txtStream.AtEndOfStream
    strNextLine = txtStream.ReadLine
    If strNextLine <> "" Then

    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set folder = FSO.GetFolder(strNextLine)


    For Each file In folder.Files
        If Mid(file.Name, InStrRev(file.Name, ".") + 1) = "xls" Then
            Workbooks.Open strNextLine & Application.PathSeparator & file.Name

        Set wb = Workbooks("Equipment Further Documentation List.xls")
    For Each sh In Workbooks("Master File.xls").Worksheets
        sh.Copy After:=wb.Sheets(wb.Sheets.Count)
    Next sh

     ActiveWorkbook.Close SaveChanges:=True
     ActiveWorkbook.CheckCompatibility = False

        End If


    Next file
    End If

    Loop
txtStream.Close

End Sub

Answer 1

So, some tips for you:

1st. (according to comment)

Add as a first line to your sub: Application.ScreenUpdating = false and add the other line right before End Sub : Application.ScreenUpdating = true

2nd. Move this line (it's setting constance reference):

Set wb = Workbooks("Equipment Further Documentation List.xls")

before:

Do Until txtStream.AtEndOfStream

3rd is just a tip.

To see the progress of your sub add the following line:

Application.StatusBar = file.Name

after this line:

Workbooks.Open strNextLine & Application.PathSeparator & file.Name

Before the End Sub add additionally this code:

Application.StatusBar = false

As a result you can see in Excel app, in the status bar, file name which is currently in process.

Keep in mind that working with 500 files must be time-consuming.

Answer 2

I have finally solved my problem...

The solution was to add a line of code:

Application.Wait (Now + TimeValue("0:00:01"))

after the line:

sh.Copy After:=wb.Sheets(wb.Sheets.Count)

which allowed time to copy the sheet to the new excel file.

So far it has been working like a charm.

I want to thank everyone that helped me with this issue.

Many Thanks.