次のファイルに移動する前にファイルを閉じる

Question

このマクロは、ディレクトリ内のすべてのファイルをループし、そのデータをテーブルとしてフォーマットします。

テーブルの列JをLargestからSmallestに並べ替えて、次のファイルに移動する前にファイルを保存する必要があります。現在、すべてのファイルを開いたままにしています。 WB.Close True：

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 

Answer 1

あなたはワークブックをClose行が欠落しています。

注意（ワークブックの使用WB.Close Falseに加えた変更を保存したくない場合）：デフォルトでは、それは仮定しますので、あなたは、あなたが開いているブックにWorksheetオブジェクトを設定されていませんActiveSheet（最後にこのブックを保存したときはActiveSheet）です。

以下のコード試してみてください。互換性チェックがポップアップ表示さ

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