VBA | シート名を一括で変更するサンプル

エクセルファイルのシート名を変更する機会が多いと思います。

本記事では、エクセルファイルのシート名を一括で変更するサンプルプログラムを紹介しています。

ぜひ、業務効率化にお役立て下さい。

プログラム例

Sub ボタン1_Click()

Dim iRow As Integer
Dim fName As String
Dim sheetNm(255) As Variant

iRow = 2
Do
sheetNm(iRow - 2) = Cells(iRow, 2).Value
iRow = iRow + 1
Loop Until Cells(iRow, 2).Value = ""

fName = Cells(1, 3).Value
fName = Right(fName, Len(fName) - InStrRev(fName, "\"))

Workbooks(fName).Activate

iRow = 2
'シート名を変更していく
Do
Worksheets(iRow - 1).Name = sheetNm(iRow - 2)
iRow = iRow + 1
Loop Until sheetNm(iRow - 2) = ""

End Sub

Sub ボタン2_Click()

Dim iRow As Integer
Dim sheetNm As Variant

sheetNm = Array()

iRow = 2

'フォルダの選択
With Application.FileDialog(msoFileDialogOpen)
.Title = "ファイルを選択"
.AllowMultiSelect = False
With .Filters
.Clear
.Add "Excelブック", "*.xls; *.xlsx; *.xlsm", 1
End With

If .Show = -1 Then
targetName = .SelectedItems(1)
Else
Exit Sub
End If

Cells(1, 3).Value = targetName

End With

Workbooks.Open Filename:=targetName

For k = 1 To Sheets.Count
ReDim Preserve sheetNm(UBound(sheetNm) + 1)
sheetNm(UBound(sheetNm)) = Sheets(k).Cells(1, 4).Value
Next k

'ActiveWorkbook.Close
iRow = 2
Workbooks("シート名変更.xlsm").Activate

Range(Cells(2, 1), Cells(255, 2)).Value = ""

For Each st In sheetNm
Cells(iRow, 1).Value = st
Cells(iRow, 2).Value = st
iRow = iRow + 1
Next

End Sub

実行画面

シート名一括変更のサンプル画像

スポンサーリンク