任意のシートの有無によって処理を分けたい場合に使えるサンプルコードです。
' シートの有無を確認する (1) '
Sub ChkSheetSample1()
Dim xWsheet As Worksheet
Dim xFlag As Boolean
For Each xWsheet In Worksheets
If xWsheet.Name = "確認したいシート名" Then xFlag = True
Next xWsheet
If xFlag = True Then
' 該当のシートがある場合の処理 '
MsgBox "あり"
Else
' 該当のシートがない場合の処理 '
MsgBox "なし"
End If
End Sub
' シートの有無を確認する (2) '
Sub ChkSheetSample2()
Dim xWsheet As Worksheet
On Error Resume Next
Set xWsheet = Worksheets("確認したいシート名")
On Error GoTo 0
If xWsheet Is Nothing Then
' 該当のシートがない場合の処理 '
MsgBox "なし"
Else
' 該当のシートがある場合の処理 '
MsgBox "あり"
End If
End Sub
(1)は確認したいシートがあるか全てのシート内でチェックして、該当のシートがあればxFlagの値をTrueにセットして、該当のシートがある場合の処理を実行します。なお、ブール型(Boolean)の初期値はFalseなので、該当のシートがない場合は、xFlagの値はFalseのままとなり、シートがない場合の処理が実行されます。
(2)は確認したいシート名をSetステートメントでとりあえず代入しています。該当のシートがある場合は、xWsheetにオブジェクトが代入されて、シートがある場合の処理が実行されます。また、該当のシートがない場合は、xWsheetの値はNothingのままとなり、シートがない場合の処理が実行されます。
※ 任意のシート名をそのままSetステートメントに代入した場合、該当のシートがなければ、『実行時エラー '9' :インデックスが有効範囲にありません。』エラーが発生して処理が中断されてしまいます。従って、一旦、"On Error Resume Next"ステートメントでエラーメッセージを非表示にして先に進め、代入後、"On Error GoTo 0"で、先のエラー処理を無効にして(元の状態に戻して)います。
くおりあ様
返信削除コードの共有ありがとうございました。
現在以下Do While loopの繰り返し処理のコードの一部として活用させていただいているのですが、4周目で
Worksheets("分割入力テンプレート").Activate でインデックスが有効範囲にありませんというエラーが表示されます。何が問題なのでしょうか?
Option Explicit
Sub 分割先テンプレートコピー()
'変数宣言
Dim パス名 As String
Dim ファイル名 As String
Dim 貼付行 As String
Dim 選択範囲 As Range
Dim xWsheet As Worksheet
'ファイル名取得
パス名 = ActiveWorkbook.Path & "¥分割コピー¥"
ファイル名 = Dir(パス名 & "*.xlsx")
'ブックコピー
Do While ファイル名 <> ""
Workbooks.Open パス名 & ファイル名
On Error Resume Next
Set xWsheet = Worksheets("分割入力テンプレート")
On Error GoTo 0
If xWsheet Is Nothing Then
' 該当のシートがない場合の処理 '
ActiveWindow.Close
Else
' 該当のシートがある場合の処理 '
Worksheets("分割入力テンプレート").Activate
Set 選択範囲 = Range("e10")
Set 選択範囲 = 選択範囲.Resize(, 9)
選択範囲.Select
Selection.Copy
ActiveWindow.ActivateNext
貼付行 = Range("A65536").End(xlUp).Row + 1
Range(Cells(貼付行, 1), Cells(貼付行, 1)).Select
ActiveSheet.Paste
ActiveWindow.ActivateNext
ActiveWorkbook.Save
ActiveWindow.Close
End If
ファイル名 = Dir()
Loop
End Sub