CODEWITHSUNDEEP
vbaexcel
Brian Fischer
Brian Fischer

Reputation: 55

Close file before moving onto the next file

This macro loops through all the files in a directory and formats the data as a table.

I need to sort Column J on the table from Largest to Smallest and then save the file before moving onto the next file. Currently it leaves all the files open.

Sub LoopThroughFiles()

FolderName = "C:\Folder1\"
If Right(FolderName, 1) <> Application.PathSeparator Then FolderName = FolderName & Application.PathSeparator
Fname = Dir(FolderName & "*.xls")

'loop through the files
Do While Len(Fname)
  With Workbooks.Open(FolderName & Fname)
    Dim tbl As ListObject
    Dim rng As Range

    Set rng = Range(Range("A1"), Range("A1").SpecialCells(xlLastCell))
    Set tbl = ActiveSheet.ListObjects.Add(xlSrcRange, rng, , xlYes)
    tbl.TableStyle = "TableStyleMedium2"
    Columns("A:L").Select
    Columns("A:L").EntireColumn.AutoFit
  End With

  'go to the next file in the folder
  Fname = Dir
Loop

End Sub

Upvotes: 0

Views: 78

Answers (1)

Shai Rado
Shai Rado

Reputation: 33682

You are missing the line where you Close the workbook : WB.Close True.

(if you don't want to save the changes made to the workbook use WB.Close False)

Note: you are not setting the Worksheet object on the workbook you open, so by default it will assume the ActiveSheet, which is the last ActiveSheet the last time you saved this workbook.

Try the code below:

Sub LoopThroughFiles()

Dim WB As Workbook

FolderName = "C:\Folder1\"
If Right(FolderName, 1) <> Application.PathSeparator Then FolderName = FolderName & Application.PathSeparator
fname = Dir(FolderName & "*.xls")

Application.ScreenUpdating = False
Application.DisplayAlerts = False

'loop through the files
Do While Len(fname)
    Set WB = Workbooks.Open(FolderName & fname) '<-- set the workbook object
    With WB
        Dim tbl As ListObject
        Dim rng As Range

        Set rng = Range(Range("A1"), Range("A1").SpecialCells(xlLastCell))
        Set tbl = ActiveSheet.ListObjects.Add(xlSrcRange, rng, , xlYes)
        tbl.TableStyle = "TableStyleMedium2"
        Columns("A:L").Select
        Columns("A:L").EntireColumn.AutoFit
    End With
    WB.Close True ' <-- close workbook and save changes
    ' go to the next file in the folder
    fname = Dir
Loop

Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

Upvotes: 1

Related Questions