読者です 読者をやめる 読者になる 読者になる

順次、選択、そして繰り返し

プログラミングのことやITのこと、たまに演劇のことも書きます。

シート集約マクロを作成してみた

同じフォルダ内にある複数の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

集約したシートを保存するブックの名前を入力して、
ボタンを押す

f:id:sndstudy:20160703231014p:plain


このフォルダ内の.xls .xlsx .xlsm の1シート目を
コピーして1つのブックに集約する
f:id:sndstudy:20160703231035p:plain

hoge.xlsxが作成される
f:id:sndstudy:20160703231538p:plain

hoge.xlsxを開くと各ファイルからシートがコピーされている。
f:id:sndstudy:20160703231629p:plain