エクセルのシート名一括変更

投稿者 : わだ     投稿日時 : 2022/06/24(Fri) 07:20:40     OS : Windows 10     EXCEL : Excel 2019

---

エクセルのシート名を一括で変更できるvbaは可能でしょうか？
イメージはB1〜B20に変更したいシート名を入力し、ボタンひとつで一括でシート名が変更されるようなイメージなのですが‥‥

投稿者 : さんこう     投稿日時 : 2022/06/24(Fri) 07:49:09

---

参考になれば。

https://www.google.com/search?q=%E3%82%A8%E3%82%AF%E3%82%BB%E3%83%AB%E3%82%B7%E3%83%BC%E3%83%88%E5%90%8D+%E4%B8%80%E6%8B%AC%E5%A4%89%E6%9B%B4

投稿者 : てらてら     投稿日時 : 2022/06/24(Fri) 09:36:32

---

こんにちは。

名前リストのあるシートもシート名が変更になるので注意ですね。
変更したくないシートは、元のシート名を入れておくべきでしょう。
ちなみにiとjは共通にしてもいいのですが、一応分けておきました。

Sub test()

    Dim i As Long, j As Long
    Dim ws As Worksheet
    
    Set ws = Worksheets("Sheet1")       '名前リストのあるシート名をセット
    
    j = 1                               '名前リスト行の初期値
    For i = 1 To Worksheets.Count
       
        If ws.Cells(j, "B") = "" Then Exit For
        
        Worksheets(i).Name = Cells(j, "B")
        
        j = j + 1
    Next i

End Sub

投稿者 : ピロリ     投稿日時 : 2022/06/24(Fri) 11:54:30

---

別案で書いてみました。
綺麗なコードではないかも ですが、一応ご参考まで。

Sub ボタンの処理()
    
    Dim Sh As Variant
    Dim i As Integer
    
    Set Sh = ActiveSheet.Range("B1:B20")        '名称一覧を配列へ格納
    
    On Error Resume Next
    
    'まずはシート名称を変更してみます。（失敗も有り得る前提で...）
    For i = 1 To Worksheets.Count
        If Sh(i) = "" Then Exit For
        Worksheets(i).Name = "失敗の" & Sh(i)   '後ろに同名のシートが有る場合の暫定処理
        Worksheets(i).Name = Sh(i)              '後ろに同名のシートが有った場合は処理されない
    Next i
    
    'シート名称変更のリトライしてみます。（失敗が有った前提で...）
    For i = 1 To Worksheets.Count
        If Sh(i) = "" Then Exit For
        If Left(Worksheets(i).Name, 3) = "失敗の" Then
            Worksheets(i).Name = Sh(i)          '名称変更に失敗したシートへ再設定してみる
        End If
    Next i
    
End Sub

投稿者 : わだ     投稿日時 : 2022/06/25(Sat) 19:07:15

---

ありがとうございます。
せっかくいただいたコードですが、何も動作起きずでした。
やりかたが悪かったようです。
勉強します......


■[返信 2] てらてらさん（2022-06-24 09:36:32）の記事
＞ こんにちは。
＞
＞ 名前リストのあるシートもシート名が変更になるので注意ですね。
＞ 変更したくないシートは、元のシート名を入れておくべきでしょう。
＞ ちなみにiとjは共通にしてもいいのですが、一応分けておきました。
＞
＞ Sub test()
＞
＞ Dim i As Long, j As Long
＞ Dim ws As Worksheet
＞
＞ Set ws = Worksheets("Sheet1") '名前リストのあるシート名をセット
＞
＞ j = 1 '名前リスト行の初期値
＞ For i = 1 To Worksheets.Count
＞
＞ If ws.Cells(j, "B") = "" Then Exit For
＞
＞ Worksheets(i).Name = Cells(j, "B")
＞
＞ j = j + 1
＞ Next i
＞
＞ End Sub

投稿者 : わだ     投稿日時 : 2022/06/25(Sat) 19:08:05

---

ありがとうございます。
せっかくいただいたコードですが、何も動作起きずでした。
やりかたが悪かったようです。
初心者は勉強します......

■[返信 3] ピロリさん（2022-06-24 11:54:30）の記事
＞ 別案で書いてみました。
＞ 綺麗なコードではないかも ですが、一応ご参考まで。
＞ Sub ボタンの処理()
＞
＞ Dim Sh As Variant
＞ Dim i As Integer
＞
＞ Set Sh = ActiveSheet.Range("B1:B20") '名称一覧を配列へ格納
＞
＞ On Error Resume Next
＞
＞ 'まずはシート名称を変更してみます。（失敗も有り得る前提で...）
＞ For i = 1 To Worksheets.Count
＞ If Sh(i) = "" Then Exit For
＞ Worksheets(i).Name = "失敗の" & Sh(i) '後ろに同名のシートが有る場合の暫定処理
＞ Worksheets(i).Name = Sh(i) '後ろに同名のシートが有った場合は処理されない
＞ Next i
＞
＞ 'シート名称変更のリトライしてみます。（失敗が有った前提で...）
＞ For i = 1 To Worksheets.Count
＞ If Sh(i) = "" Then Exit For
＞ If Left(Worksheets(i).Name, 3) = "失敗の" Then
＞ Worksheets(i).Name = Sh(i) '名称変更に失敗したシートへ再設定してみる
＞ End If
＞ Next i
＞
＞ End Sub
＞

投稿者 : ピロリ     投稿日時 : 2022/06/25(Sat) 20:29:47

---

私のPCでは問題なく動いているのですが ？？？
サンプル： Sub ボタンの処理() は動作時には、下記コードの通り、名称一覧の記載されているシートが
アクティブ状態でないと動作しません。　別のシートを表示してたってことはないでしょうか？
＞ 　　Set Sh = ActiveSheet.Range("B1:B20")　　　　'名称一覧を配列へ格納

ちなみに、てらてらさんのサンプルでは、名称一覧を「Sheet1」シートへ記載する必要があります。
＞ 　　Set ws = Worksheets("Sheet1")　　　'名前リストのあるシート名をセット

あとは、ステップ実行して確認してみてはいかがでしょう。