« ディレクトリ内EXCELファイルのヘッダ/フッタ一括変換 | トップページ | ディレクトリ内EXCELファイル内容の一括検索 »

ディレクトリ内EXCELファイルの対象シート削除

EXCEL / VBA / 対象シート削除

昨日投稿した、ヘッダの一括変換に続いて。

Private Sub XXXXXX()
    '================================
    ' ディレクトリ内の全ブックをループ
    '================================
    Dim myPath As String
    Dim myFName As String
    Dim myDelSheet As String
    Dim myOriginalBook As Workbook
   
    Set myOriginalBook = ActiveWorkbook
   
    ' ヘッダ部接頭語を取得
    myDelSheet = Worksheets(1).Range("DELETE_SHEET").Value

    ' パスを取得
    myPath = ActiveWorkbook.Path
    ' 自ファイルが存在しているディレクトリをカレントディレクトリに設定
    ChDir myPath
    myFName = Dir("*.xls")
    ' ファイルがなくなるまで検索
    Do Until myFName = ""
        If Not (myOriginalBook.Name = myFName) Then
            ' ファイルOPEN
            Workbooks.Open Filename:=myFName

            '================================
            ' 全シート内で、削除対象同じシート名があれば削除
            '================================
            Dim MySheet As Sheets
            Dim SCount As Integer
            Set MySheet = ActiveWorkbook.Sheets
            SCount = MySheet.Count

            ' シート数が1件だった場合は削除できないのでスルー
            If Not SCount = 1 Then
                ' 全ワークシートをループ
                For mycount = 1 To SCount
                    ' mycount件めのシートをアクティブにする
                    Worksheets(mycount).Activate
               
                    ' 削除対象のシートが存在した場合
                    If ActiveSheet.Name = myDelSheet Then
                        ' シート削除の確認メッセージを非表示
                        Application.DisplayAlerts = False
                        
                        ' シート削除
                        ActiveSheet.Delete
                        
                        ' 確認メッセージを表示するよう修正
                        Application.DisplayAlerts = True
                   
                        ' ループを抜ける
                        Exit For
                    End If
                Next mycount
            End If
   
            ' 一番先頭のシートをアクティブにする
            Worksheets(1).Activate
            
            ' ファイルを保存してCLOSE
            Workbooks(myFName).Close SaveChanges:=True
        End If

        ' 次のファイル名を設定
        myFName = Dir()
    Loop
End Sub

|

« ディレクトリ内EXCELファイルのヘッダ/フッタ一括変換 | トップページ | ディレクトリ内EXCELファイル内容の一括検索 »

EXCEL」カテゴリの記事

コメント

コメントを書く



(ウェブ上には掲載しません)




トラックバック


この記事へのトラックバック一覧です: ディレクトリ内EXCELファイルの対象シート削除:

« ディレクトリ内EXCELファイルのヘッダ/フッタ一括変換 | トップページ | ディレクトリ内EXCELファイル内容の一括検索 »