ブックのシート名を一括で置換するエクセルVBA

5125 ワード
自動化 VBA Excel 効率化 Excel テキストリンク

ブックのシート名を一括で置換するエクセルVBAをご紹介します。

次のサンプルコードを使うと、


  • 「ファイルを開く」ダイアログを表示。

  • シート名を一括で置換したいエクセルブックを選択。

  • エクセルブックに含まれる全シート名を一括で置換する。


という作業を自動化します。

操作方法


1、
「ブックのシート名を取得して一覧表を作成するエクセルVBA」を実行してシート名を取得。

2、
「シート名一覧」の「シート名（変更後）」に希望シート名を入力。

3、
下記サンプルコードを含むエクセルファイルを開き→「開発」→「マクロ」の順でクリック。
「Aシート名置換」→「実行」の順でクリック。

4、
ファイルを開くダイアログが表示されるので、シート名を置換したい対象のエクセルブックをクリックして、「開く」をクリック。

5、
マクロが実行されます。
「シート名一覧」以外のシート名を一括で置換します。

完了です。

サンプルコード


Sub Aファイルを開く()
    Dim OpenFileName As String

OpenFileName = Application.GetOpenFilename("Excelファイル,*.xls*")

If OpenFileName = "False" Then

    MsgBox "キャンセルされました。処理を終了します。"

    End

Else
    Workbooks.Open OpenFileName

End If


End Sub
Sub Aシート名置換()
    Dim ws As Worksheet
    Dim row, col As Long
    Dim wsNames As Collection
    Dim sh As Variant, flag As Boolean

Set wsNames = New Collection

Call Aファイルを開く

'画面更新停止
Application.ScreenUpdating = False

'確認ダイアログ停止
Application.DisplayAlerts = False

For Each sh In Sheets
    If sh.Name = "シート名一覧" Then
        flag = True
        Exit For
    End If
Next sh

If flag = True Then

    Worksheets("シート名一覧").Select
    Range(Range("A2"), Cells(Rows.Count, 2).End(xlUp)).Select

    row = Selection.row
    col = Selection.Column

    Do While Not IsEmpty(Cells(row, col))
        ' KeyがStrig型でないと「型が一致しません」というエラーになる
        wsNames.Add Item:=Cells(row, col + 1).Value, _
                     Key:=CStr(Cells(row, col).Value)
        row = row + 1
    Loop

For Each ws In ActiveWorkbook.Worksheets
    On Error Resume Next
    ws.Name = wsNames.Item(ws.Name)
Next


Else

    'メッセージ表示
    MsgBox "シート「シート名一覧」はありません。" & Chr(13) & "先に「シート名取得」を実行して下さい。" & Chr(13) & "処理を終了します"

ActiveWindow.Close

End If

'画面表示ON
Application.ScreenUpdating = False


End Sub

コードの特徴