[[20200503140025]]　『新規ブックへマクロボタンコピーしたい』（ゆう）　ページの最後に飛ぶ

『新規ブックへマクロボタンコピーしたい』（ゆう）

複数シートがあり、マクロボタンをクリックすると、シート名の一覧を作りたいのですが、下記コードだと新規ブックが作成され、マクロボタンも消えてしまいます。

"【シート一覧】"シートのA2より下にシート名の一覧が出来ています。
シートを追加したり、削除してマクロボタンをクリックすると、シート削除され新しくシートができシート名が貼付けられます。

できれば、"【シート一覧】"シートのA2、B2より下のデータがクリアされ、A2より下にシート名が貼付けられるように変更したいです。

どのように変更すればよろしいでしょうか？

Sub シート一覧を作成する()

'変数の宣言
Dim row_num As Long 'シート名を張り付けるセルの行番号
Dim col_num As Long 'シート名を張り付けるセルの列番号
Dim ws As Worksheet '一覧シートを探すためのシート（WorkSheetの略）
Dim ws2 As Variant '対象となるシート（WorkSheetの略）
Dim sheetName As String 'シート一覧を出力するシート名

'シート一覧のシート名を決める
sheetName = "【シート一覧】"

'各シートを順番に見ていく際に、その都度、再計算や再表示等が行われると
'処理が重くなるので、一時的にオフにする
Application.EnableEvents = False

 Application.Calculation = xlCalculationManual
 Application.ScreenUpdating = False

'４．開いているExcelファイルに、すでに「【シート一覧】」がある場合、そのシートを
' 削除してから一覧を作成する

'「For Each」を使い、全シートをぐるぐる回す
For Each ws In Worksheets

'シートをぐるぐる回す中で、対象となるシートの名前が
'「【シート一覧】」かどうかを判定
If ws.Name = sheetName Then

'シート名が「【シート一覧】」の場合、重複することになるので
'以下のシート削除処理を実行

'「削除しますか」と聞かれると処理が止まるので、一時的にオフにする
Application.DisplayAlerts = False

'シートの削除
ws.Delete

'「削除しますか」の表示をオンにする
Application.DisplayAlerts = True

'同じ名前のシートはないはずなので、残りのシートは確認する必要がないため
'「For Each」を抜ける。
Exit For

End If

Next ws

'３．シート名一覧は「【シート一覧】」という名前のシートを新規で追加し、そこに表示する

'先頭に空白のシートを追加する
Worksheets.Add before:=Worksheets(1)

'追加したシートの名前を「【シート一覧】」に変更する
ActiveSheet.Name = sheetName

'せっかくなので、わかりやすいよう「【シート一覧】」のタブの色を黄色にする
ActiveSheet.Tab.ColorIndex = 36

'２．開いているExcelファイルのシート名を一覧にする。

'貼り付けを開始するセルの位置を決める。
row_num = 1

 col_num = 1

'「【シート一覧】」を削除した時と同じように「For Each」を使い、全シートをぐるぐる回す
For Each ws2 In Sheets

'シートをぐるぐる回す中で、対象となるシートの名前を取り出して、セルに張り付ける
Cells(row_num, col_num).Value = ws2.Name

'貼り付け先を位置を次の行（下のセル）に移動させる
row_num = row_num + 1

Next ws2

'処理の最初でオフにした再計算等の設定をオンに戻しておく
Application.EnableEvents = True

 Application.Calculation = xlCalculationAutomatic
 Application.ScreenUpdating = True

'終わったことがわかるように、画面にメッセージを出す
MsgBox "終了しました"

End Sub

＜使用 Excel：unknown、使用 OS：unknown ＞

＞どのように変更すればよろしいでしょうか？
ざっと流し読みしただけですが、そこまでご自身で作れたなら、頭の整理をしてから作り直したほうが早いとおもいます。

分からないまま何かを参考にしたなら、まずはそちらのコードを理解することが先決のようにおもいます。

このほか、ダメではないですが、インデントをきちんとつけて読みやすくすると、ご自身のデバッグ作業がやりやすくなるとおもいます。

（もこな２） 2020/05/03(日) 14:35

考え方を変えて

 (1)【シート一覧】があればクリア、無ければ作成する
 (2)全シートを巡回して、【シート一覧】でなければ、書き出す

という例です

    Sub さんぷる()
        Dim dstSH As Worksheet
        Dim 最終行 As Long
        Dim c As Long
        Dim SH As Worksheet

        Stop 'ブレークポイントの代わり

        '▼自ブックの【シート一覧】シートをクリア（ない場合は作成）
        On Error Resume Next
        Set dstSH = ThisWorkbook.Worksheets("【シート一覧】")
        On Error GoTo 0

        If dstSH Is Nothing Then
            Worksheets.Add ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
            Set dstSH = ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
            dstSH.Range("A1:B1").Value = Array("なんちゃら", "かんちゃら")
            dstSH.Name = "【シート一覧】"
        Else
            With dstSH
                最終行 = .Cells(.Rows.Count, "A").End(xlUp).Row
                If 最終行 > 1 Then
                    .Range("A2:B" & 最終行).ClearContents
                End If
            End With
        End If

        '▼全シートを巡回して【シート一覧】じゃなきゃ書き出す
        c = 2
        For Each SH In ThisWorkbook.Worksheets
            If SH.Name <> dstSH.Name Then
                dstSH.Cells(c, "A").Value = SH.Name
                c = c + 1
            End If
        Next SH
    End Sub

（もこな２） 2020/05/03(日) 14:59

もこな２様

いつも本当にありがとうございます。
VBA勉強します。

またインデントをきちんとつけて読みやすくするように心がけます。

（ゆう） 2020/05/05(火) 11:12

コメント返信：

[ 一覧(最新更新順) ]

[[20200503140025]] 『新規ブックへマクロボタンコピーしたい』（ゆう） ページの最後に飛ぶ

[[20200503140025]]　『新規ブックへマクロボタンコピーしたい』（ゆう）　ページの最後に飛ぶ