Excel 2007 crashes when saving workbook after running Macro

[wazzman]

Hi All,

Like many, I'm new to VBA and have had a tough time with a macro that I've pieced together...I need some help, please .

I have been trying to write a Macro that opens up all workbooks in a particular folder which then copies the first sheet of each of those workbooks to the workbook that is running the macro into separate new sheets.

Where I have got to is that I have the macro, I can run it and it will do pretty much what I want. But....when I go to save the file Excel crashes - every time. Thing is it doesn't crash immediately. I can interact with the workbook, delete sheets, change things etc etc, but when I go to 'save' or 'save as' it will crash.

If anyone has any suggestions, I would really appreciate it. This thing is killing me! The code is below, apologies if it isn't very polished and awkward, but it's all I got.

Just a couple of notes which might help: "Open Workbooks.xlsb" is the workbook that has and runs the macro and is where the sheets are copied to from the other workbooks in the folder. The files (.xlsx) I'm opening and closing are in the "C:\Test\" folder and I'm doing this on a notebook running XP.

Thanks in advance to anyone who might be able to help!




Public Sub OpenWorkbooksThenCopySheetToCurrentWorkBook()

Dim strFile As String
Dim strDirectory As String


strDirectory = "C:\Test\"

strFile = Dir(strDirectory & "*.xlsx*")


Do Until strFile = ""


Workbooks.Open strDirectory & strFile

Workbooks(strFile).Activate

Sheets(strFile).Select
Sheets(strFile).Copy After:=Workbooks("Open WorkBooks.xlsb"). _
Sheets(3)

Workbooks("Open WorkBooks.xlsb").Activate

Workbooks(strFile).Activate

Workbooks(strFile).Close SaveChanges:=False


Workbooks("Open WorkBooks.xlsb").Activate

strFile = Dir()

Loop


End Sub

 

[CharlesChuckieCharles]

you don't appear to close "Open WorkBooks.xlsb"

 

[CharlesChuckieCharles]

"Open WorkBooks.xlsb" is the current workbook (badly named) is it a binary workbook, the other workbooks aren't (XML) maybe change from copying the sheet across to copy/paste?

 

[wazzman]

Thanks for the quick reply. You wouldn't believe it, but I've got it working. I've changed the sheet reference to select "Table" (name of the sheet I was trying to copy) and it now works??? No crash.

I also changed the filename to reference any workbook running the macro, rather than "Open WorkBooks". You are right, not a good name! Thanks for your help.



Public Sub CopySheetsToCurrentWorkBook()

Dim strFile As String
Dim strDirectory As String
Dim curWkBk

Application.DisplayAlerts = False
Application.EnableEvents = False
Application.ScreenUpdating = False


curWkBk = ActiveWorkbook.Name
Workbooks(curWkBk).Activate

strDirectory = "C:\Test\"

strFile = Dir(strDirectory & "*.xlsx*")


Do Until strFile = ""


Workbooks.Open strDirectory & strFile

Workbooks(strFile).Activate

Sheets("Table").Select
Sheets("Table").Copy after:=Workbooks(curWkBk). _
Sheets(3)

Workbooks(curWkBk).Activate

Workbooks(strFile).Activate

Workbooks(strFile).Close SaveChanges:=False


Workbooks(curWkBk).Activate

strFile = Dir()

Loop

Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub