Reputation: 1
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
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