Unable to close previous workbook

[home_toast]

Hi guys,

I am having trouble with the following code that I have been writing. I am not sure how to close the previous workbook.

Sub openFiles()

Dim FileDir As Variant
Dim FileName As Variant
Dim xName As String

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

xlsFileDir = "H:\InternalFiles\data\test\"
xlsFileName = Dir(xlsFileDir & "*.xls")
Do While xlsFileName <> ""
Workbooks.Open Filename:=xlsFileDir & xlsFileName, _
UpdateLinks:=False
xName = Dir("*.xls") 'Not sure if this is the correct way to do it.
Cells.Select
Selection.Copy
Windows("Data_Project.xlsm").Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Cells.EntireColumn.AutoFit
Sheets.Add After:=Sheets(Sheets.Count)
Windows(xName).Activate 'This part is not working. I cannot close the previous workbook.
ActiveWorkbook.Close
xlsFileName = Dir
Loop
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
End Sub

I am greatful for any solutions. Thanks.

Regards,
TJ

 

[RichardMGreen]

Try this (untested):-

Sub openFiles()
    Dim FileDir As Variant, FileName As Variant, xName As String, file_to_open As Workbook
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.EnableEvents = False
    xlsFileDir = "H:\InternalFiles\data\test\"
    xlsFileName = Dir(xlsFileDir & "*.xls")
    Do While xlsFileName <> ""
        Set file_to_open = Workbooks.Open(xlsFileDir & xlsFileName, UpdateLinks:=False)
        Cells.Copy
        ThisWorkbook.Activate
        Selection.PasteSpecial (xlPasteValues)
        Application.CutCopyMode = False
        Cells.EntireColumn.AutoFit
        Sheets.Add After:=Sheets(Sheets.Count)
        file_to_open.Close False 'closes workbook without saving changes
        xlsFileName = Dir
    Loop
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.EnableEvents = True
End Sub

 

[home_toast]

Try this (untested):-

Sub openFiles()
    Dim FileDir As Variant, FileName As Variant, xName As String, file_to_open As Workbook
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.EnableEvents = False
    xlsFileDir = "H:\InternalFiles\data\test\"
    xlsFileName = Dir(xlsFileDir & "*.xls")
    Do While xlsFileName <> ""
        Set file_to_open = Workbooks.Open(xlsFileDir & xlsFileName, UpdateLinks:=False)
        Cells.Copy
        ThisWorkbook.Activate
        Selection.PasteSpecial (xlPasteValues)
        Application.CutCopyMode = False
        Cells.EntireColumn.AutoFit
        Sheets.Add After:=Sheets(Sheets.Count)
        file_to_open.Close False 'closes workbook without saving changes
        xlsFileName = Dir
    Loop
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.EnableEvents = True
End Sub

Hi Richard,

Made some slight changes to the VBA code but it works perfectly.

Thanks.

Regards,
TJ

 

[RichardMGreen]

Glad to help, and thanks for the feedback.