EXCEL VBA 複数シート選択の方法

質問

エクセルVBAのシート選択方法について教えてください。
選択対象シート数は4つで、シート名は、「101」「102」「103追加工」「104」とします。

シート名「表紙」のセルは
A1：101　A2：102　A3：103追加工　A4：104となっており、
使用者はB1～B4セルに「○」「×」を入力し、
「○」となっているシートのみ選択出来るようにしたい。
下記マクロの場合、シート名が全角文字だと使えるのですが、
シート名が「101」のように半角数字だけの場合コピーできません。
どこを修正すればよいのでしょうか？

Sub TestSample2()
Dim c As Range
Dim flg As Boolean
On Error Resume Next
flg = True
ThisWorkbook.Activate　
With Worksheets("表紙")
　For Each c In .Range("B1:B4")
　　If c.Value Like "○*" Then
　　　 Worksheets(c.Offset(, -1).Value).Select flg
　　　 flg = False
　　End If
　Next c
End With
　With ActiveWindow.SelectedSheets
　If .Count > 0 Then
　　 .Copy
　End If
　End With
　'元のシートに戻る場合
　'Application.Goto ThisWorkbook.Worksheets("表紙").Range("A1")
End Sub

回答No.4

cj_mover · ベストアンサー

こんにちは。お邪魔します。

> シート名が「101」のように半角数字だけの場合コピーできません。
実際のシート名とリスト上のシート名とで、全半角の相違があれば、
当然エラーになりますけれど、ここでの問題点は恐らく、
半角かどうかというより、文字列なのか。数値なのか、
きちんと区別して理解できていない、ということかな？と思います。
例えば、
　　Worksheets(101)
は、１番めのシート、の意味で。
　　Worksheets("101")
は、"101"という名前のシートです。
101は数値、"101"は数字文字列（または単に数字）です。
WorksheetsやSheetsなどのインデックスには、
数値としての.Indexと文字列としての.Nameを指定できますから、
数字文字列を指定したい時は、文字列として指定して挙げなければなりません。
以上を踏まえて、元のコードに手を加えると、以下のような感じ。

' ' ///
Sub Re8360796a()
　　Dim c As Range
　　Dim flg As Boolean

　　On Error Resume Next
　　flg = True
　　ThisWorkbook.Activate

On Error GoTo ErrOut_
　　For Each c In Worksheets("表紙").Range("B1:B4")
　　　　If c.Value Like "○*" Then
　　　　　　Worksheets(c.Offset(, -1).Text).Select flg
　　　　　　flg = False
　　　　End If
　　Next c

'　　With ActiveWindow.SelectedSheets
'　　　　If .Count > 0 Then　　'　　ActiveWindow.SelectedSheets.Countは最低でも１です。
'　　　　　　.Copy
'　　　　End If
'　　End With

　　If Not flg Then ActiveWindow.SelectedSheets.Copy

　　' ' 元のシートに戻る場合
'　　Worksheets("表紙").Select
　　Exit Sub

ErrOut_:
　　MsgBox """表紙""シートに記載されたシート名" & c.Offset(, -1).Text & "は存在しません。" & _
　　　　vbLf & "全角半角の相違を含め、シート名を確認してください。", vbInformation
End Sub
' ' ///

ActiveWindow.SelectedSheets.Countが、０になることはありませんから、
コードを見る限り、意図が解らないのですが、
リストに対して○が一つも付いていないなら、コピーしない、という意味なら、
flgフラグをそのまま使って判別可能です。
ポイントは、.Valueではなくて、.Textプロパティを用いること。
これなら、数値であれ何であれ、
セルに表示された文字列　を取得できますから、
名前のリストからオブジェクトを指定する場合は、.Textプロパティをお奨めします。

おまけ、になりますが、
　　Worksheets(Array("101","102","103追加工","104")).Select
のようにインデックスに直接配列を指定することも可能ですから、
下の例では、文字列変数 ShNames に順次、シート名を区切り文字（CR）を挟んで連結したものを
Split()関数で配列化し、一度に複数のシートを選択します。
.Copyメソッドを実行するだけで、実際は.Selectする必要はないようなので、直に.Copyしていますが、
もし、選択が必要なら、
　　　　Worksheets(Split(Mid$(ShNames, 2), vbCr)).Select
のように選択可能です。

' ' ///
Sub Re8360796c()
　　Dim c As Range
　　Dim ShNames As String

　　ThisWorkbook.Activate

　　For Each c In Worksheets("表紙").Range("B1:B4")
　　　　If c.Value Like "○*" Then
　　　　　　ShNames = ShNames & vbCr & c(1, 0).Text
　　　　End If
　　Next

　　If ShNames <> "" Then
On Error GoTo ErrOut_
　　　　Worksheets(Split(Mid$(ShNames, 2), vbCr)).Copy
　　End If

　　' ' 元のシートに戻る場合
'　　Worksheets("表紙").Select
　　Exit Sub
ErrOut_:
　　MsgBox """表紙""シートに記載されたシート名は存在しないものが含まれています。" & _
　　　　vbLf & "全角半角の相違を含め、シート名を確認してください。", vbInformation
End Sub
' ' ///

尚、ご質問に合わせる形で、Worksheetsを使っていますが、Sheets()でも同じ結果になります。

お礼

こんばんは。
早速の追加回答をして頂き、本当にありがとうございます。
参考にさせていただきます。

回答No.5

keithin

ん？

＞○が付いてないときメッセージを表示してマクロを終了でよい

さくっと
if application.countif(worksheets("表紙").range("B1:B4"), "*○*") = 0 then
msgbox "NO MARK"
exit sub
end if

とかで。

再掲：
＞そこはご質問じゃないので…別途ご相談としてまたご質問なさってみて下さい。

人の話きいてますか？

お礼

ありがとうございました。
初心者で申し訳ございません。
新たに質問を投稿しなかった件についてお詫び申し上げます。
また、投稿の確認が遅くなり、たいへん申し訳ございませんでした。
また機会がございましたら、これに懲りずによろしくお願い申し上げます。

回答No.3

keithin

＞Worksheets(c.Offset(, -1).Value).Select flg
のところを

Worksheets(c.Offset(, -1).text).Select flg

に変えてやるだけでＯＫです。

＃余談ですが
ちなみに今のマクロだと，「どこにも○が付いてなくても勝手に一枚コピーする」動作になってます。
まぁそこはご質問じゃないのでスルーしますが，「○が一つもなかったらコピーしたくない」としたいのでしたら，別途ご相談としてまたご質問なさってみて下さい。

お礼

こんばんは。
早速の追加回答をして頂き、本当にありがとうございます。

ご指摘のように「どこにも○が付いてなくても勝手に一枚コピーする」動作になってました。
これは回避したいと思います。
○が付いてないときメッセージを表示してマクロを終了でよいと思っていますが、
アドバイスをいただけると助かります。
よろしくお願い申し上げます。

回答No.2

WindFaller

単純なことですが、
>A1：101　A2：102　A3：103追加工　A4：104となっており、
A列の部分を、マクロで書いたらよいのではありませんか？

'//「表紙」シートで

Sub SheetNames()
Dim sh As Worksheet
Dim i As Long
　 For Each sh In Worksheets
　　　i = i + 1
　　　Cells(i, 1).Value = "'" & sh.Name　'プレフィックスは文字列書式だから影響はない
　 Next sh
End Sub
'//

お礼

こんばんは。
早速の追加回答をして頂き、本当にありがとうございます。
参考にさせていただきます。

回答No.1

YUKKER

数字のみだと数列と認識され、「101という名前のシート」ではなく
「101番目のシート」と指定してしまっているのが原因のようです。
Cstrで文字列に変換して、シート名を指定するようにするとうまくいきました。
修正箇所は下記コメント箇所の一行です。

Sub TestSample2()
Dim c As Range
Dim flg As Boolean
On Error Resume Next
flg = True
ThisWorkbook.Activate
With Worksheets("表紙")
For Each c In .Range("B1:B4")
If c.Value Like "○*" Then
Worksheets(CStr(c.Offset(, -1).Value)).Select flg '←修正箇所
flg = False
End If
Next c
End With
With ActiveWindow.SelectedSheets
If .Count > 0 Then
.Copy
End If
End With
'元のシートに戻る場合
'Application.Goto ThisWorkbook.Worksheets("表紙").Range("A1")
End Sub

お礼

こんばんは。
早速の追加回答をして頂き、本当にありがとうございます。
参考にさせていただきます。