Ｅｘｃｅｌマクロについての質問です。

質問

Ｅｘｃｅｌのマクロについての質問です。
マクロについての質問です。
以下のようなマクロを作成しました。
このマクロを動作させているのはこのマクロを作成したファイル上です。

Sub Macro9()

Dim WBA As Workbook
Dim WBB As Workbook
Dim WSA As Worksheet
Dim WSB As Worksheet
Set WBA = Workbooks("Ａ")
Set WBB = Workbooks("Ｂ")
Set WSB = WBB.Worksheets("1")

For i = 100 To 3000 Step 20

Worksheets.Add Before:=Worksheets("Sheet1")

Dim k As String

k = i

ActiveSheet.Name = (k / 100)

Set WSA = WBA.Worksheets(k / 100)

WSB.Range("A1:AY30").Copy Destination:=WSA.Range("A1")
WSA.Range("D4:I30").Clear
WSA.Range("Q4:V30").Clear
WSA.Range("AD4:AI30").Clear
WSA.Range("AQ4:AV30").Clear

Next i

Application.DisplayAlerts = False
Sheets("Sheet1").Delete
Application.DisplayAlerts = True

Application.DisplayAlerts = False
Sheets("Sheet2").Delete
Application.DisplayAlerts = True

Application.DisplayAlerts = False
Sheets("Sheet3").Delete
Application.DisplayAlerts = True

End Sub

そこで質問ですが、このマクロを作動させると何のエラーの表示もなく最後まで動作は完了します。
ですが、シートの作成は30まで作成できてもその後のセルのコピー＆ペーストはなぜかシート6.8までしかできていません(7～30までのシートはシート作成はできているのですがコピペのみが実行されず空白のままになっています。)
シートもコピペも両方ともシート30まで完了するにはどの点を改善すればいいのでしょうか？

知恵が足りずどうしても直す事が出来ません。
長文申し訳ございませんが是非皆さまのお知恵をお貸しください。
宜しくお願い致します。

回答No.2

queuerev2 · ベストアンサー

うまくいかなかったのですか。
検証しておらず申し訳ありませんでした。

そこで検証してみたのですが、質問者様の状況がちょっとよくわかりません。
質問者様の方でご指摘のエラー（「インデックスが有効範囲にありません」）が出る場所はNo.1の回答で修正した部分なのでしょうか。

というのは、こちらでもNo.1の修正を行ったコードで確かにご指摘の通りのエラーが出たのですが、それは
Set WBA = Workbooks("Ａ")
のところであり、しかも、No.1の修正をしてもしなくてもこのエラーは発生しました。
この部分のエラーについては、ファイル名の拡張子まで指定することで解消しました。

上記のエラー解消後の検証では、No.1の回答については期待通りの動作をしました。
すなわち、修正前は6.8までしかデータがコピーされず、いずれかの修正を行ったところ30までコピーされました。

なお、こちらではコードはブックＢの標準モジュールに置きました。

もし、質問者様のところでエラーの出ている場所が Set WBA = Workbooks("Ａ") 以外のところであるなら補足いただければ、と思います。

なお、他にも修正した方がいいところがあります。
まずNo.1の回答ですが、エラーの原因ばかり考えていたため、一応動くもののあまり気の利いた回答ではありませんでした。
また、マクロ開始時にWBA以外のブックがアクティブになっているとうまく動きませんでした。
他にもデフォルトのActiveWorkBookを使っている場所がありますので、ブックはＡであるものとみなして修正しました。
このような事を考慮して修正したコードを示します。

コードを置く場所ですが、
モジュールは標準モジュールしかテストしていません。
ブックはＢにしてありますがＡでも他のブックでも大丈夫です。
ブック名は実際のファイル（ブック）に合わせて書き直してください。

Sub Macro9()

Dim WBA As Workbook
Dim WBB As Workbook
Dim WSA As Worksheet
Dim WSB As Worksheet
'Set WBA = Workbooks("Ａ")
'Set WBB = Workbooks("Ｂ")
Set WBA = Workbooks("Ａ.xlsx")
Set WBB = Workbooks("Ｂ.xlsm")
'↑この2行のブック名（ファイル名）は実際のファイルに合わせて要修正
'xlsとxlsxの両方を使う可能性がある場合等拡張子が一定しない場合は、
'上の2行のかわりに下の5行でうまくいくかもしれない
'Dim e
'For Each e In Workbooks
' If UCase(e.Name) Like "Ａ.XL*" Then Set WBA = Workbooks(e.Name)
' If UCase(e.Name) Like "Ｂ.XL*" Then Set WBB = Workbooks(e.Name)
'Next
Set WSB = WBB.Worksheets("1")

For i = 100 To 3000 Step 20

'Worksheets.Add Before:=Worksheets("Sheet1")
Set WSA = WBA.Worksheets.Add(Before:=WBA.Worksheets("Sheet1"))

Dim k As String

'k = i
k = i / 100

'ActiveSheet.Name = (k / 100)
WSA.Name = k

'Set WSA = WBA.Worksheets(k / 100)

WSB.Range("A1:AY30").Copy Destination:=WSA.Range("A1")
WSA.Range("D4:I30").Clear
WSA.Range("Q4:V30").Clear
WSA.Range("AD4:AI30").Clear
WSA.Range("AQ4:AV30").Clear

Next i

Application.DisplayAlerts = False
'Sheets("Sheet1").Delete
WBA.Sheets("Sheet1").Delete
Application.DisplayAlerts = True

Application.DisplayAlerts = False
'Sheets("Sheet1").Delete
WBA.Sheets("Sheet2").Delete
Application.DisplayAlerts = True

Application.DisplayAlerts = False
'Sheets("Sheet1").Delete
WBA.Sheets("Sheet3").Delete
Application.DisplayAlerts = True

End Sub

お礼

非常に丁寧にご回答頂きありがとうございます。

とても参考になりました。
修正頂きました部分を反映させてもう一度検証してみましたところ正常に作動し、自分が作りたいと思うマクロを作成することができました。

お忙しい中非常に親身になってご回答頂き本当にありがとうございました。
本当に助かりました。

回答No.1

queuerev2

Set WSA = WBA.Worksheets(k / 100)
を
Set WSA = WBA.Worksheets(CStr(k / 100))
や
Set WSA = WBA.Worksheets(k / 100 & "")
などとしてはいかがでしょうか。
検証していないのでうまくいかなかったら申し訳ありません。
その場合補足くだされば再検討します。

補足

ご回答ありがとうございます。
ご提案いただいた案を検証させて頂きましたがどちらを試してみても「インデックスが有効範囲にありません」とメッセージが出てしまいマクロが作動しません。
度々申し訳ありませんがこの問題について改善案などご検討いただければ幸いです。
宜しくお願い致します。