エクセルVBAの質問 開いているもう一つのブックのシート名をすべて取得する方法

質問

おはようございます。
現在マクロを実行しているブックのシート名を下のようなコードで取得していますが、これを
開いているもうひとつのブックのシート名を
マクロ実行しているシート“しーと1”のJ3セル以降に並べる

というように変更したいのですが、下のコードを少し変更して
対応できるでしょうか？教えていただけたら助かります。

Sub シート名()
Dim i As Integer
Dim mySheetCnt As Integer
Dim mySheetNam As String
Application.ScreenUpdating = False
Columns("J:J").Select
Selection.ClearContents
Range("J2").Select
ActiveCell.FormulaR1C1 = "項目名"

mySheetCnt = ThisWorkbook.Sheets.Count

For i = 2 To mySheetCnt
mySheetNam = Sheets(i).Name
Sheets("しーと1").Cells(i, 10) = mySheetNam
Next i
Application.ScreenUpdating = True
MsgBox "シート名更新しました。"
End Sub

回答No.4

onlyrom · ベストアンサー

再度の登場、onlyromです。

＞いただいたコードを自分で直せず申し訳ありません。

いえ、いえ、別にどうってことありませんよ。
考え過ぎましたね。(^^;;;

＞調べる対象は「もうひとつのブック」限定に書出したい

なら、先の回答にブック名をチェックするコードを入れるだけでいいのですが、
今度は、For Eachで。

'------------------------------------------------
Sub Test555()
　Dim myBook As Workbook
　Dim mySheet As Worksheet
　Dim LastRow As Long

　Application.ScreenUpdating = False

　ThisWorkbook.Activate
　Sheets("しーと1").Select

　Columns("J:J").ClearContents
　Range("J2").Value = "シート名"

　For Each myBook In Workbooks
　　　If myBook.Name <> ThisWorkbook.Name Then
　　　　　For Each mySheet In myBook.Worksheets
　　　　　　　LastRow = Cells(Rows.Count, "J").End(xlUp).Row
　　　　　　　Cells(LastRow + 1, "J").Value = mySheet.Name
　　　　　Next mySheet
　　　End If
　Next myBook

　Application.ScreenUpdating = True
　MsgBox "該当ブックのシート名を表示しました"
End Sub
'-----------------------------------------------

上記は、マクロのブックと他に１つブックが開いている場合です。
もし、他に複数のブックが開いていて、その中のどれか、という場合は、
そのどれかを決めてやらなければできません。

他に複数ブックが開いていてその中の、"売上.xls"　というブックを対象にしたい場合は

　　If myBook.Name <> ThisWorkbook.Name Then
これを
　　If myBook.Name = "売上.xls" Then
とします。

それからマクロの書いてあるブックがアクティブで、かつ、シート１がアクティブな状態で
実行する場合は、下記２行はいりません。

　ThisWorkbook.Activate
　Sheets("しーと1").Select

また、常に、ブック名、シート名をRangeオブジェクトの前に付加する場合もいりません。

以上。

お礼

どうもありがとうございました。勉強になりました。二つのブックということを操作しようとすのは、思った以上のことでした。又是非宜しくお願いします。

回答No.3

Wendy02

こんにちは。

ご質問者のreprogress様は、マクロは、かなりお分かりになるようですね。

>調べる対象は「もうひとつのブック」限定

やはり確実なのは、全部出すことですが、それを、#2のお礼で書かれている「もうひとつのブック」というのを限定するというのは、思っているよりも難しいのです。

通常は、元のコードの
mySheetCnt = ThisWorkbook.Sheets.Count
　を、
mySheetCnt = ActiveWorkbook.Sheets.Count
　として、
ActiveWorkbook.Sheets(i).Name

として、人間が選択したほうが早いです。

ただし、
For i = 1 To mySheetCnt 'i = 1
mySheetNam = Sheets(i).Name
Sheets("しーと1").Cells(i + 2 , 10) = mySheetNam ' i+2(3行目から）
Next i
としたほうがよいです。

「もうひとつのブック」というのは、言葉では、単数なのですが、Excel VBAのプログラミングになれた人は、本能的に、その言葉を、必ずしも、「合計2ブック」としてコードを書くわけではありません。見えないブックも、いくつか立ち上がっていることがあります。また、足りないこともあります。

こういうことは、余計だと思うかもしれませんが、なるべく問題が起こらないような形の許容範囲でマクロを考えます。

私の場合、「もうひとつのブック」を、見えているもので、立ち上げた順序が、自ブック以外で一番早いものという限定をしました。
なお、ActiveWorkbook がどちらでも、自ブック以外のシート名（ワークシート名だけではありません）を同じように書き出します。

Worksheet とSheet の区別があります。

----------------------------------------
Sub Macro1()
　　Dim wb As Workbook
　　Dim tWb As Workbook
　　Dim i As Integer
　　'もうひとつのブックを探す
　　For Each wb In Workbooks
　　　　If wb.Name <> ThisWorkbook.Name _
　　　　　　And wb.Windows(1).Visible = True Then
　　　　　　Set tWb = wb
　　　　　　Exit For
　　　　End If
　　Next wb
　　If tWb Is Nothing Then
　　　MsgBox "もうひとつのブックがありません。", 48
　　　Exit Sub
　　End If
　　Application.ScreenUpdating = False
　　With ThisWorkbook.Worksheets("しーと1")
　　　　.Columns(10).ClearContents
　　　　.Range("J2").Value = "*項目名*"
　　　　For i = 1 To tWb.Sheets.Count
　　　　　　.Cells(i + 2, 10).Value = tWb.Sheets(i).Name
　　　　Next i
　　End With
　　Application.ScreenUpdating = True
　　Set tWb = Nothing
　　MsgBox "シート名更新しました。", 64
End Sub

お礼

Wendy02さんありがとうございます。
>「もうひとつのブック」というのを限定するというのは、思っているよりも難しいのです。

知らなかったです。コードばっちりでした。Wendy02さんの回答はいつも参考にさせていただいています。今回最初の方からも解決の答えをいただきましたので、次点にさせていただくこと、申し訳ありません。また是非宜しくお願いします。

回答No.2

onlyrom

どうせなら、ThisWorkbookも含め開いているブックの全シート名を表示する方がいいような。。。

ということで、開いている全てのブックの全シート名を、ThisWorkbookの"しーと1"のＪ列、Ｋ列・・・に表示。
またそれぞれの列の１行目には、ブック名を表示。

'-------------------------------------------------
Sub Test()
　Dim B As Integer
　Dim S As Integer
　Dim BookCnt As Integer
　Dim SheetCnt As Integer

　Application.ScreenUpdating = False

　ThisWorkbook.Activate
　Sheets("しーと1").Select

　For B = 1 To Workbooks.Count
　　　SheetCnt = 0
　　　BookCnt = BookCnt + 1
　　　Columns(BookCnt + 9).ClearContents
　　　Cells(1, BookCnt + 9).Value = Workbooks(B).Name
　　　Cells(2, BookCnt + 9).Value = "シート名"

　　　For S = 1 To Workbooks(B).Sheets.Count
　　　　　SheetCnt = SheetCnt + 1
　　　　　Cells(SheetCnt + 2, BookCnt + 9).Value = Workbooks(B).Sheets(S).Name
　　　Next S
　Next B

　Application.ScreenUpdating = True
　MsgBox "開いているブックの全シート名を表示しました"
End Sub
'-----------------------------------------------------

●For B=1 to workbooks.Count
の代わりに
●For Each B In Workbooks
とする方法を使うとコードが若干短くなります。
以上。

お礼

ありがとうございました。せっかく書いていただいて恐縮ですが、調べる対象は「もうひとつのブック」限定に書出したいと考えています。いただいたコードを自分で直せず申し訳ありません。

回答No.1

nyankonosuke

Sub シート名()
Dim i As Integer
Dim mySheetCnt As Integer

'シート名を配列に格納するために、配列で変数を定義

Dim mySheetNam(256) As String

Application.ScreenUpdating = False

mySheetCnt = ThisWorkbook.Sheets.Count

'このループでシート名の取得は完了

For i = 2 To mySheetCnt
mySheetNam(i) = Sheets(i).Name
Next i

'別のブックに記述するという要件なので、別ブックをアクティブに
Windows("Book2.xls").Activate

Columns("J:J").Select
Selection.ClearContents
Range("J1").Select
ActiveCell.Value = "項目名"

'このループで取得したシート名をセルに代入

For n = 2 To mySheetCnt
Sheets("しーと1").Cells(n, 10).Value = mySheetNam(n)
Next n

Application.ScreenUpdating = True
MsgBox "シート名更新しました。"
End Sub
＝＝＝
上記で良いでしょうか？
excel2003では正常に動きました。