select case内で配列の値を貼り付ける方法

以下のコードのエラーを解決する方法と、書き方がきれいではない部分をご教示ください。

下のコードで、ワークブックAWBの集計シートから取得したデータを、ReportTypeによって、Book1.xlsmのAAAからFFFのいずれかのシートに貼り付けたいです。
Select caseの手前まではエラーなく進むのですが、Select caseの中に入ると、各貼り付けのところで、アプリケーション定義またはオブジェクト定義のエラーが生じます。

あと、見よう見まねで書いているので、動いている箇所でも書き方が良くない場所があればぜひご指摘ください。

よろしくお願いいたします。


Dim MWB As Workbook
Dim AWB As Workbook
Dim AnsFolder As String
Dim AnsFile As String
Dim ReportType As String
Dim nRow As Long
Dim i As Long
Dim temp As Variant

Application.ScreenUpdating = False

Set MWB = Workbooks("Book1.xlsm")
AnsFolder = "C:\test\"

nRow = MWB.Worksheets("List").Cells(Rows.count, 2).End(xlUp).Row

For i = 3 To nRow
AnsFile = MWB.Worksheets("List").Cells(i, 2).Value

Workbooks.Open AnsFolder & AnsFile
Set AWB = Workbooks(AnsFile)

ReportType = MWB.Worksheets("List").Cells(i, 5).Value
temp = AWB.Worksheets("集計").Range(Cells(7, 1), Cells(7, 2000)).Value
MWB.Activate

Select Case True
Case ReportType Like "*AAA"
MWB.Worksheets("AAA").Range(Cells(i, 2), Cells(i, 2001)) = temp

Case ReportType Like "*BBB"
MWB.Worksheets("BBB").Range(Cells(i, 2), Cells(i, 2001)) = temp

Case ReportType Like "*CCC"
MWB.Worksheets("CCC").Range(Cells(i, 2), Cells(i, 2001)) = temp

Case ReportType Like "*DDD"
MWB.Worksheets("DDD").Range(Cells(i, 2), Cells(i, 2001)) = temp

Case ReportType Like "*EEE"
MWB.Worksheets("EEE").Range(Cells(i, 2), Cells(i, 2001)) = temp

Case ReportType Like "*FFF"
MWB.Worksheets("FFF").Range(Cells(i, 2), Cells(i, 2001)) = temp

End Select

AWB.Close (False)

Next

Application.ScreenUpdating = True

End Sub

No.1 ベストアンサー 回答者： x-1919 回答日時： 2015/07/17 13:51

ブックやシートの構成がわからないので勘違いがあるかもしれません。

やろうとしていることは、、、

Book1.xlsm の中に "List", "AAA", "BBB", "CCC", "DDD", "EEE", "FFF" というシートがある。
List シートの B3 から下に向かってファイル名書いてあり、E列には ReportType の値が書いてある。
そのレコード行数分だけ処理を行う。
B列の値に合致するファイルを開き、そのファイルの "集計" シート 7行目の 1 ～ 2000列の値を Book1.xlsm のシート "AAA" ～ "FFF" のいずれかのシートの、とある行の 2 ～ 2001列に転記する。
「とある行」 とは、現在 List シートで処理している行と同じ行番号である。
"AAA" ～ "FFF" のどのシートに転記するかは、List シートで処理している行の E列に書いてある文字列の右から 3文字分で決定する。

といった感じでしょうか？
違っていたらごめんなさい。

で、面倒なので細かいところまで検証していませんが、質問文にあるコードでは 同時に 2つのブックを開き、複数のシートにまたがって行ったり来たりしています。
こういう場合、Cells や Rows などの要素は単独で書かず、必ず親要素から指定してあげてください。 じゃないと質問者が意図しているブック & シートのセルではないブック & シートのセルを VBA が見に行っちゃう事があります。
具体的に挙げると
temp = AWB.Worksheets("集計").Range(Cells(7, 1), Cells(7, 2000)).Value
これの Range 以降に出てくる Cells はどのブックのどのシートのセルなのか不明です。 もし集計シートのセルを意図しているのであれば
temp = AWB.Worksheets("集計").Range(AWB.Worksheets("集計").Cells(7, 1), AWB.Worksheets("集計").Cells(7, 2000)).Value
と書かなければなりません。

これはコードが長くなってしまってかなり面倒なので、シートも Worksheet 変数で参照してしまったほうがよいでしょう。

Dim AWB As Workbook
Dim awbSummary As Worksheet
Set AWB = ・・・
Set awbSummary = AWB.Worksheets("集計")
としておけば
temp = awbSummary.Range(awbSummary.Cells(7, 1), awbSummary.Cells(7, 2000)).Value
と書くことができます。

そこら辺を諸々書き直したコードです。
字下げしているところは全角スペースで埋めているので、コピペする場合は半角スペースに置換してください。
上記で述べた部分以外、Select - Case で出力先シートを決めている部分も書き直しています。
ReportType に格納されている文字列の右端から 3文字分の値が対象シートの名前と一致する仕様であればこのような書き方でも問題ないと思います。

Sub hoge()
　　Dim MWB As Workbook
　　Dim mwbList As Worksheet ' MWB ブックの "List" シート
　　Dim mwbOutput As Worksheet

　　Dim AWB As Workbook
　　Dim awbSummary As Worksheet ' AWB ブックの "集計" シート

　　Dim AnsFolder As String
　　Dim AnsFile As String
　　Dim ReportType As String
　　Dim nRow As Long
　　Dim i As Long
　　Dim temp As Variant

　　Set MWB = Workbooks("Book1.xlsm")
　　Set mwbList = MWB.Worksheets("List")

　　AnsFolder = "C:\test\"

　　nRow = mwbList.Cells(mwbList.Rows.Count, 2).End(xlUp).Row

　　For i = 3 To nRow
　　　　AnsFile = mwbList.Cells(i, 2).Value

　　　　Set AWB = Workbooks.Open(AnsFolder & AnsFile)
　　　　Set awbSummary = AWB.Worksheets("集計")

　　　　ReportType = mwbList.Cells(i, 5).Value
　　　　temp = awbSummary.Range(awbSummary.Cells(7, 1), awbSummary.Cells(7, 2000)).Value

　　　　Set mwbOutput = MWB.Worksheets(Right(ReportType, 3))
　　　　mwbOutput.Range(mwbOutput.Cells(i, 2), mwbOutput.Cells(i, 2001)) = temp
　　　　AWB.Close (False)

　　　　Set AWB = Nothing
　　　　Set mwbOutput = Nothing
　　Next
End Sub

この回答へのお礼

早速ご回答いただきありがとうございます。ご推察のとおりです。rangeの所ですが、その手前でAWB.Worksheets("集計").と指定しているので、改めて書く必要が無いと思っていました。
勉強になりました。

お礼日時：2015/07/17 14:42