エクセルファイルのシート名を変更する機会が多いと思います。
本記事では、エクセルファイルのシート名を一括で変更するサンプルプログラムを紹介しています。
ぜひ、業務効率化にお役立て下さい。
プログラム例
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 |
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 |
実行画面
