Jaybreezy
Jaybreezy

Reputation: 1

VBA code not stable

It started on Monday this week, when I finished with my code,the codes purpose was to pull data from a specific sheet in a specific folder from all spreadsheets in that folder.

But just last night he started crashing excel spreadsheet every time i pushed the run button.

Any idea why?

Option Explicit

Sub ImportSheet()
    Dim i As Integer
    Dim SourceFolder As String
    Dim FileList As Variant
    Dim GrabSheet As String
    Dim FileType As String
    Dim ActWorkBk As String
    Dim ImpWorkBk As String
    Dim NoImport As Boolean
Application.EnableEvents = False
    SourceFolder = "C:\Users\Jarryd.Ward\Desktop\Test\"
    FileType = "*.xlsx"
    GrabSheet = "Summary"
    FileList = ListFiles(SourceFolder & "/" & FileType)

    Application.ScreenUpdating = False
    ActWorkBk = ActiveWorkbook.Name
    NoImport = False

    For i = 1 To UBound(FileList)
        Workbooks.Open (SourceFolder & "\" & FileList(i))
        ImpWorkBk = ActiveWorkbook.Name
        On Error Resume Next
            ActiveWorkbook.Sheets(GrabSheet).Select
            If Err > 0 Then
                NoImport = True
                GoTo nxt
            End If
            Err.Clear
        On Error GoTo 0

        ActiveWorkbook.Sheets(GrabSheet).Copy After:=Workbooks(ActWorkBk).Sheets(Workbooks(ActWorkBk).Sheets.Count)
           ActiveSheet.Name = ImpWorkBk

        On Error Resume Next
            ActiveSheet.Name = FileList(i) & " - " & GrabSheet
            Err.Clear
        On Error GoTo 0
nxt:
        Workbooks(ImpWorkBk).Activate
        Application.DisplayAlerts = False
        ActiveWorkbook.Saved = True
        ActiveWorkbook.Close SaveChanges:=False
        Application.DisplayAlerts = True
        Workbooks(ActWorkBk).Activate
    Next i
    Application.ScreenUpdating = True
End Sub

Upvotes: 0

Views: 591

Answers (1)

John Muggins
John Muggins

Reputation: 1198

Try opening and closing your files this way to see if it helps. It should minimize the calls to activate this or that. And closing out by variable instead of activesheet will insure that your code isn't trying to close the main workbook by accident.

Sub testOpen()
Dim manyWBs As Workbook
Dim myWB As Workbook


Set myWB = ThisWorkbook


For Each file In folder
    Set manyWBs = Workbooks.Open("C:\temp\filename")


'   do events.......
manyWBs.Worksheets("Sheet1").Range("A1:B13").Copy _
       Destination:=myWB.Worksheets("Sheet1").Range("A1:b13")




    manyWBs.Close
    Set manyWBs = Nothing
Next file




Set myWB = Nothing
End Sub

Upvotes: 1

Related Questions