決まったシートだけコピーして一つのシートにまとめる

質問

お世話になります。
http://okwave.jp/qa/q8216220.html
で質問させていただいたVBAをこねくり回してみたのですが、「インデックスが有効範囲にありません」というエラーがでて進まなくなってしまいました。

Sub 特定のシートだけコピーと貼り付け()

Dim k As Long, endRow As Long, wS As Worksheet
Dim P As Variant

P = Array("全", , "A", "B", "C", "D", "E", "F", "G", "H", "I")
'↑コピーしたいシート名一覧

Set wS = Worksheets("まとめ")
endRow = wS.cells(Rows.Count, "B").End(xlUp).Row

If endRow > 4 Then
Range(wS.cells(5, "B"), wS.cells(endRow, "M")).ClearContents
End If

For k = LBound(P) To UBound(P)

☆If Worksheets(k).Name <> "まとめ" Then 'ワークシート名が"まとめ"のとき
endRow = Worksheets(P).cells(Rows.Count, "B").End(xlUp).Row 'P＝Arrayで指定しているシートのセルで
If endRow > 4 Then '4行目より下を
Range(Worksheets(P).cells(5, "B"), Worksheets(P).cells(endRow, "M")).Copy _
wS.cells(Rows.Count, "B").End(xlUp).Offset(1)

'B5からM列の任意のデータが入っているセルまでコピーして"まとめ"シートに貼り付け

End If '繰り返す

End If '繰り返す

Next k '次のシートへ

End Sub

自分で分かるようにコメントを付けています。
☆のついているところで、「インデックスが有効範囲にありません」と出ます。
指定したシートに"まとめ"を追加してみてもやはり同じでした。
調べたところ、「インデックスが～」というのはVBA中の範囲にないものを指定しているからだ、ということなのですが・・・。
お知恵を貸して下さい。よろしくお願いします。

回答No.5

tom04 · ベストアンサー

No.２です。

投稿後に気づきました。
すでにお判りだと思いますが、前回のコードの最後から５行目
＞Range(.Cells(5, "B"), .Cells(endRow, "N")).Copy wS.Cells(Rows.Count, "B").End(xlUp).Offset(1)

は
＞Range(.Cells(5, "B"), .Cells(endRow, "M")).Copy wS.Cells(Rows.Count, "B").End(xlUp).Offset(1)

の間違いです。（タイピングミスをしていました）
N列までのコピー＆ペーストにしていましたので
M列に変更してください。

それともう１点
＞P = Array("全", , "A", "B", "C", "D", "E", "F", "G", "H", "I")
の部分「全」と「A」の間のカンマが一つ多いような気がするのですが・・・

何度も失礼しました。m（_ _）m

お礼

補足ありがとうございます。
Nまでになっていたのは気づいて修正していたので問題ありません。
カンマが一つ多いのは、私がコピペしたときに実際のシート名をアルファベットに変更したので、その時のコピペミスです。ご指摘ありがとうございます。
大変助かりました。ありがとうございます！

回答No.4

cj_mover

＃３、ｃｊです。

一時的な錯覚を基に大ポカのレスを書いてしまいました。
内容に誤りがありますし、そもそもレスをする事由がありませんでしたので、
全面的に撤回させてください。

大変申し訳ありませんでした。

お礼

いえいえ、ありがとうございます。
注釈の部分とても参考になりました。

回答No.3

cj_mover

こんにちは。

まず問題点を。

「インデックスが有効範囲にありません」というエラーになる原因２つ
> P = Array("全", , "A", "B", "C", "D", "E", "F", "G", "H", "I")
【, ,】これ何もない値（Empty値）を配列の要素に指定しています。
Worksheets(Empty)と指定すると、
コピーしたいシート名一覧、ということなのですから
必要十分なものを指定しましょう。
→　P = Array("全", "A", "B", "C", "D", "E", "F", "G", "H", "I")
> Worksheets(k)
この指定も、今回のケースでは
　　Worksheets(P(k))
です。

> If endRow > 4 Then
> Range(wS.cells(5, "B"), wS.cells(endRow, "M")).ClearContents
> End If
ここで問題なのは、Rangeの扱いです。
Rangeには親オブジェクトとしてのSheetが必ずあること
省略していい場合とダメな場合があることを
恒に意識するようにしましょう。
→　wS.Range(wS.Cells(5, "B"), wS.Cells(endRow, "M")).ClearContents
親オブジェクトを省略してRangeから書き始めても構わないのは
　「標準モジュール」に書かれた場合の「アクティブシート」
　　を指定したい場合
　　　この場合　省略形の　Range　は
　　　Application.ActiveSheet.Range　を　指します。
　「シートモジュール」に書かれた場合の「モジュールに関連付けられたシート」
　　を指定したい場合
　　　例えば、Sheet1 モジュール　に　書かれた　省略形の　Range　は
　　　Sheet1.Range　または　Sheets("Sheet1").Range　を　指します。
構文として
　Range(Cells(index), Cells(index))
を使う場合で言うと
　sheet.Range(sheet.Cells(index), sheet.Cells(index))
と親オブジェクトを統一する必要があります。
もし、
　Range(sheet.Cells(index), sheet.Cells(index))
が問題なく（エラーなく）通るとすれば、そもそも
　Range(Cells(index), Cells(index))
で済むことだった場合か、
たまたま都合よくアクティブシートが一致した場合などです。

以下の部分も同様に
> Range(Worksheets(P).cells(5, "B"), Worksheets(P).cells(endRow, "M")).Copy _
> wS.cells(Rows.Count, "B").End(xlUp).Offset(1)
→　Worksheets(P(k)).Range(Worksheets(P(k)).Cells(5, "B"), Worksheets(P(k)).Cells(endRow, "M")).Copy _
→　wS.Cells(Rows.Count, "B").End(xlUp).Offset(1)
とするのが正しいです。

> ☆If Worksheets(k).Name <> "まとめ" Then 'ワークシート名が"まとめ"のとき
コピーしたいシート名一覧、を配列にしてあるのですから、
コピーしたいシートだけを指定することで、
この条件分岐は不要となります。

以上を踏まえて、ご提示のコードに修正を加えると以下のように。

' ' ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝

Sub Re8217697()

　　Dim k As Long, endRow As Long, wS As Worksheet
　　Dim P As Variant

' ' コピーしたいシート名一覧'　　★
　　P = Array("全", "A", "B", "C", "D", "E", "F", "G", "H", "I")

' ' まとめシート　を　変数wSに確保
　　Set wS = Worksheets("まとめ")
' ' まとめシート　の　最下行位置を取得
　　endRow = wS.Cells(Rows.Count, "B").End(xlUp).Row

' ' まとめシート　で　５行め以下にデータがあるなら消去 '　　★★
　　If endRow > 4 Then
　　　　wS.Range(wS.Cells(5, "B"), wS.Cells(endRow, "M")).ClearContents
　　End If

' ' コピーしたいシート名一覧　を　順次ループ
　　For k = LBound(P) To UBound(P)

　　' ' コピーしたい各シート　の　最下行位置を取得
　　　　endRow = Worksheets(P(k)).Cells(Rows.Count, "B").End(xlUp).Row

　　' ' コピーしたい各シート　で　５行め以下にデータがあるなら
　　　　If endRow > 4 Then

　　' ' コピーしたい各シート　の　"Ｂ５：Ｍ最下行位置"　を　コピー
　　' ' まとめシート　の　最下行下に貼付け '　　★★
　　　　　　Worksheets(P(k)).Range(Worksheets(P(k)).Cells(5, "B"), Worksheets(P(k)).Cells(endRow, "M")).Copy _
　　　　　　wS.Cells(Rows.Count, "B").End(xlUp).Offset(1)

　　' ' B5からM列の任意のデータが入っているセルまでコピーして"まとめ"シートに貼り付け

　　' ' 条件分岐　End
　　　　End If

' ' コピーしたいシート名一覧　の　次のシート名　へ　インデックスを進める
　　Next k

End Sub

' ' ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝

次に、
　Worksheets(P(k))
何カ所も、同じシートへのアクセスを呼び直すのは、
処理面からも読みやすさの面からも好ましくないので
With ステートメントを使ってスッキリさせてみます。

' ' ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝

Sub Re8217697c()

　　Dim k As Long, endRow As Long, wS As Worksheet
　　Dim P As Variant

' ' コピーしたいシート名一覧'　　★
　　P = Array("全", "A", "B", "C", "D", "E", "F", "G", "H", "I")

' ' まとめシート　を　変数wSに確保
　　Set wS = Worksheets("まとめ")
' ' まとめシート　の　最下行位置を取得
　　endRow = wS.Cells(Rows.Count, "B").End(xlUp).Row

' ' まとめシート　で　５行め以下にデータがあるなら消去 '　　★★
　　If endRow > 4 Then
　　　　wS.Range(wS.Cells(5, "B"), wS.Cells(endRow, "M")).ClearContents
　　End If

' ' コピーしたいシート名一覧　を　順次ループ
　　For k = LBound(P) To UBound(P)

　　' ' コピーしたい各シート　を　Withステートメントで捉える
　　　　With Worksheets(P(k))
　　　　' ' コピーしたい各シート　の　最下行位置を取得
　　　　　　endRow = .Cells(Rows.Count, "B").End(xlUp).Row

　　　　' ' コピーしたい各シート　で　５行め以下にデータがあるなら
　　　　　　If endRow > 4 Then

　　　　　　' ' コピーしたい各シート　の　"Ｂ５：Ｍ最下行位置"　を　コピー
　　　　　　' ' まとめシート　の　最下行下に貼付け '　　★★
　　　　　　　　.Range(.Cells(5, "B"), .Cells(endRow, "M")).Copy _
　　　　　　　　wS.Cells(Rows.Count, "B").End(xlUp).Offset(1)

　　　　　　' ' B5からM列の任意のデータが入っているセルまでコピーして"まとめ"シートに貼り付け

　　　　' ' 条件分岐　End
　　　　　　End If

　　' ' コピーしたい各シート　の　Withステートメント　End
　　　　End With

' ' コピーしたいシート名一覧　の　次のシート名　へ　インデックスを進める
　　Next k
End Sub
' ' ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝

とりあえず、直接的な回答としては以上のようになります。
問題点を理解して貰えれば、後は、支障の無い範囲で好きなように書き替えてみてください。

お礼

すごくわかりやすい構文解説ありがとうございます！
さらっとこれくらい回答できるようになりたいなと思います。
まだまだ未熟者ですが・・・。

回答No.2

tom04

こんにちは！
前回投稿したコードに似ていますので・・・

＞インデックスが～・・・
という場合おそらくSheet名が存在しない場合のエラーが原因のような気がします。

＞☆If Worksheets(k).Name <> "まとめ" Then 'ワークシート名が"まとめ"のとき

この行は
WORKSheet(k)のSheet名が「まとめ」でない場合
になります。

前回はSheet名の指定がなかったのであのようなコードにしましたが、
今回の質問ではコピー＆ペーストするSheet名が判っているというコトなので
Sheet名を指定してそのままコピー＆ペーストで大丈夫だと思います。

Sub 特定シートのみコピーと貼り付け()
Dim k As Long, endRow As Long, wS As Worksheet, myArray
myArray = Array("全", "A", "B", "C", "D", "E", "F", "G", "H", "I")
Set wS = Worksheets("まとめ")
endRow = wS.Cells(Rows.Count, "B").End(xlUp).Row
If endRow > 4 Then
Range(wS.Cells(5, "B"), wS.Cells(endRow, "M")).ClearContents
End If
For k = 0 To UBound(myArray)
On Error Resume Next '←おまじない
With Worksheets(myArray(k))
endRow = .Cells(Rows.Count, "B").End(xlUp).Row
If endRow > 4 Then
Range(.Cells(5, "B"), .Cells(endRow, "N")).Copy wS.Cells(Rows.Count, "B").End(xlUp).Offset(1)
End If
End With
Next k
End Sub

こんなコードではどうでしょうか？m（_ _）m

お礼

実はtom04さんのコードをほとんど流用しておりました（恥）
申し訳ありません。
おまじないはエラー回避の構文でしょうか。ありがとうございます。

回答No.1

hallo-2007

エラーが出て、デバックでエディター開きます。
マウスを　
LBound(P)の上に持ってきます　たぶん、結果が　0　と出ます
UBound(P)の上に持ってきます　たぶん、結果が　10と出ます。
つまり、Kが　０　から10まで順番に変わりますよということ

Worksheets(k).Name に　0番目のシートの指定はありません。
Worksheets(k+1).Name にするか

For k = LBound(P)+1 To UBound(P)+1
にしなかればだめでしょう。
配列を指定する関数ですが、始まりが　１ではなく　０が基準となる場合多いです。

お礼

ありがとうございます。エラーの解消方法をいろいろ調べているときに、マクロの記述は0から始まる的な内容を見ていたので、それかなぁ・・・と思っていました。
参考に致します。