シート集約マクロを作成してみた - 順次、選択、そして繰り返し

同じフォルダ内にある複数のExcelブックの1シート目を
1つのブックに集約するマクロを作成してみた。

Sub CommandButton1_Click()

    Const AGG_FILE_NAME As String = "集約ファイル.xlsx"
    Const EXTENSION As String = "xls*"

    Dim szFileName As String
    Dim copySheet As Workbook
    Dim szAggFileName As String
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    '集約ファイル名を取得
    szAggFileName = Range("A2").Value
    
    If szAggFileName = "" Then
    
        'ファイル名が記入されていない場合デフォルトの値を入れる
        szAggFileName = AGG_FILE_NAME
    
    End If
    
    'ファイル存在チェック
    szFileName = Dir(ThisWorkbook.Path & "\" & szAggFileName)
    
    '存在した場合は削除する
    If szFileName <> "" Then
    
        Kill (ThisWorkbook.Path & "\" & szAggFileName)
    
    End If
    
    Set aggFile = Workbooks.Add
    
    '拡張子「.xls」「.xlsx」「.xlsm」を対象
    szFileName = Dir(ThisWorkbook.Path & "\*." & EXTENSION)
    
    'ファイルが存在しない場合は終了
    If szFileName = "" Then
    
        Exit Sub
    
    End If
           
    '各ブックの1枚目のシートを集約用ブックにコピーする
    Do
    
　　　　'マクロ自身は無視する
        If ThisWorkbook.Name <> szFileName Then
            
            Set copySheet = Workbooks.Open(Filename:=ThisWorkbook.Path & "\" & szFileName)
            
            copySheet.Worksheets(1).Copy After:=aggFile.Worksheets(aggFile.Worksheets.Count)
            
            ActiveSheet.Name = szFileName
            
            copySheet.Close
            
        End If
        
        szFileName = Dir()
    
    Loop While szFileName <> ""

    '空のシートを削除する処理
    Dim i As Integer
    i = 0
    Dim iSheetCount As Integer
    iSheetCount = 1
    
    Do While iSheetCount <= aggFile.Worksheets.Count - i
    
        If IsEmpty(aggFile.Worksheets(iSheetCount).UsedRange) = True Then
        
            aggFile.Worksheets(iSheetCount).Delete
            
            i = i + 1
        
        Else
        
            iSheetCount = iSheetCount + 1
        
        End If
    
    
    Loop
    
    Application.DisplayAlerts = True
    
    aggFile.SaveAs Filename:=ThisWorkbook.Path & "\" & szAggFileName
    
    aggFile.Close
    
End Sub