'
''******** AKIRA55.COM ******* https://akira55.com/sheets_check/
'
Sub Worksheets_Check()''EXCEL VBA ワークシートの使い方（シートの存在チェック・シート検索）
Dim ws As Worksheet
Dim ws_Name As String
ws_Name = Application.InputBox(Prompt:="シート名を入力", Title:="検索するワークシート名を入力", Default:="サッカー", Left:=100, Top:=200, Type:=3) 'InputBoxメゾット設定します。(戻り値をType:=1 数値に設定
'検索するワークシート名を入力します。
If ws_Name <> "False" Then '
For Each ws In Worksheets 'ワークシート全てを調べます
If ws.Name = ws_Name Then '入力したシート名と登録されているシート名が有るか調べます。
MsgBox "シート名：" & ws.Name & "が有りました"
Exit Sub 'シート名が有れば、シート名を表示して終了します。
End If
Next ws
Else
MsgBox "キャンセルしました。"
Exit Sub
End If
MsgBox "シート名：" & ws_Name & "は、有りませんでした"
End Sub
'
''******** AKIRA55.COM ******* https://akira55.com/sheets_check/
'
Sub Worksheets_Check02() 'EXCEL VBA ワークシートの使い方（シートの存在チェック・無い場合はシートに追加する）
Dim ws, ws01 As Worksheet
Dim ws_Name, ws_Addname As String
Dim I, lRow As Long
Set ws01 = Worksheets("マスター")
lRow = ws01.Cells(Rows.Count, "A").End(xlUp).Row 'ワークシート「マスター」A列の最終行を取得
ws_Addname = ""
For I = 2 To lRow 'ワークシート「マスター」A列の最終行まで繰り返します。
ws_Name = ws01.Cells(I, "A") 'ワークシート「マスター」のA列のシート一覧データを順番に【ws_Name】へ代入します。
For Each ws In Worksheets 'ワークシート全てを調べます
If ws.Name = ws_Name Then 'ワークシート「マスター」のA列のシート一覧データと既に登録されているか調べます。
ws_Name = ""
Exit For '既にワークシートが登録されていれば抜け出す。
End If
Next ws
If ws_Name <> "" Then
Worksheets.Add After:=Sheets(Worksheets.Count) '空のワークシートを最後尾に追加（登録されていないシート名を追加します。）
ActiveSheet.Name = ws_Name '追加したワークシートの名前を変更します。
ws_Addname = ws_Addname + ws_Name & vbCrLf
End If
Next I
If ws_Addname <> "" Then 'シートを追加したか調べます
MsgBox "追加したシート名は、：" & vbCrLf & ws_Addname & "を追加しました。"
Else
MsgBox "シートは追加しませんでした。" '追加するシートが無い場合
End If
End Sub
'
'
''******** AKIRA55.COM ******* https://akira55.com/sheets_check/
'
Sub Worksheets_Check03() 'EXCEL VBA ワークシートの使い方（シートの存在チェック・条件によるシート削除）
Dim ws As Worksheet
Dim ws_Name, ws_Addname As String
Dim Hantei As Integer
ws_Name = "*[削除]*" 'シート名に【削除】の文字列はあるものが対象になります。
ws_Addname = ""
For Each ws In Worksheets 'シートの削除対象をリスト化
If ws.Name Like ws_Name Then
ws_Addname = ws_Addname + vbCrLf & ws.Name 'シート削除対象をリスト化します。
End If
Next ws
If ws_Addname = "" Then
MsgBox "削除対象のシートは、有りませんでした" 'シート削除対象が1件もない場合
Else
Hantei = MsgBox("削除対象のシート名：" & ws_Addname & "が有ります削除しますか？", vbYesNo)
If Hantei = vbYes Then '「はい」・・削除
Application.DisplayAlerts = False 'シートを削除する際の警告メッセージ非表示（警告を無視）
For Each ws In Worksheets
If ws.Name Like ws_Name Then
ws.Delete '削除対象のシートを削除します。
End If
Next ws
Application.DisplayAlerts = True 'シートを削除する際の警告メッセージの表示（既定値）
Else
MsgBox "シート削除をキャンセルしました。"
End If
End If
End Sub
'
'
''******** AKIRA55.COM ******* https://akira55.com/sheets_check/
'
Sub Worksheets_Check04() 'EXCEL VBA ワークシートの使い方（他のブックからシート名を取得します。）
Dim Wb As Workbook
Dim Ws01, Ws02 As Worksheet
Dim FilePath As String
Dim I As Long
FilePath = Application.GetOpenFilename("Microsoft Excelブック,*.xls?")
'ダイアログボックスが表示されシート名を取得するEXCELファイルを選択します。
If FilePath = "False" Then 'ダイアログボックスのファイル選択をキャンセルした場合
MsgBox "処理を中断します"
Exit Sub '処理を中断します
End If
Set Ws02 = Worksheets("マスター")
I = 2 'シート（マスター）の２行目からシート名を転記するため
Set Wb = Workbooks.Open(FileName:=FilePath, UpdateLinks:=0, ReadOnly:=True, IgnoreReadOnlyRecommended:=True)
'選択したEXCELファイルを読み取り専用で開きます。
For Each Ws01 In Wb.Worksheets '選択したEXCELファイルの全シート分繰り返します。
Ws02.Cells(I, "A") = Ws01.Name 'シート名を取得して、シート名を転記します。
I = I + 1 '転記する行を＋１し加算します。
Next Ws01
Wb.Close '選択したEXCELファイルを閉じます
End Sub
'
