シート名の確認、無い場合は追加

指定したシート名を検索して、シート名が存在すれば、そのシート名のWorksheetを取得。
無い場合は、最終位置にシートを追加し、そのシート名のWorksheetを取得。
最終位置に追加しない場合は、シートの名前一覧を取得 を参照。

Sub Sample1()
	Dim wb As Workbook
	Dim ws As Worksheet
	Dim filename As String

	filename = "C:\ExcelVBA\シート名の確認、無い場合は追加\Sample.xlsx"

	If IsFileExists(filename) = True Then		' ファイルの有無を確認
		Set wb = Workbooks.Open(filename)	' ブックを開く
		Set ws = GetSheetsObject(wb, "星座2")	' シートを取得

		If ws Is Nothing Then
			Set ws = SheetAddEnd(wb, "星座2")
		End If

		' 処理を記載する
		' 例:取得したシートをアクティブにする
		ws.Activate
	Else
		MsgBox filename & "は存在しません", vbExclamation
	End If
End Sub


' シート名から Worksheet オブジェクトを取得する(無ければ末尾に追加)
Function GetSheetsObject(wb As Workbook, sheetname As String) As Worksheet
	Dim idx1 As Integer
	Dim ws As Worksheet

	Set ws = Nothing

	' Sheet名の一覧を取得
	For idx1 = 1 To wb.Sheets.Count
		' 探しているSheetが見つかった場合SheetのObjectを返す
		If sheetname = wb.Sheets(idx1).Name Then
			' 見つかったので関数を抜ける
			Set GetSheetsObject = wb.Sheets(idx1)
			Exit Function
		End If
	Next

	Set GetSheetsObject = ws
End Function


' シートを末尾に追加
Function SheetAddEnd(wb As Workbook, sheetname As String) As Worksheet
	Dim ws As Worksheet

	' 末尾に追加
	Set ws = wb.Worksheets.Add(after:=Worksheets(wb.Worksheets.Count))
	ws.Name = sheetname

	Set SheetAddEnd = ws
End Function

コメント