【補足】ExcelVBA複数のシートへのコピー方法

質問

「ExcelVBA複数のシートへのコピーの方法」
http://okwave.jp/qa/q8504035.html
上記質問の補足です。

'//////////////////////////////////////////////////////

「ExcelVBA別フォルダにあるブックのコピー方法」
http://okwave.jp/qa/q8488933.html

で教えていただいたコードを元に自分なりに編集したのですがうまくいきません。
結果先のシートは複数なのですが、複数のシートにコピーする編集方法がうまくいきません。

'//////////////////////////////////////////////////////

「yyyy」のファイルは「1999～2012」のファイルがあります。
　　※「yyyy」の箇所にはそれぞれの年号が入ります。
　　※例えば「1999_ファイルA.xls」
「yyyy2」のファイルは「2000～2012」のファイルがあります。
　　※「yyyy2」の箇所にはそれぞれの年号が入ります。
　　※例えば「2000_ファイルB.xls」

1_フォルダA
　∟yyyy_ファイルA.xls(Sheet名：「dateA」で統一)
2_フォルダB
　∟yyyy_ファイルB.xls(Sheet名：「dateB」で統一)
3_フォルダC
　∟yyyy2_ファイルC.xls(Sheet名：「dateC」で統一)
4_フォルダD
　∟yyyy_ファイルD.xls(Sheet名：「dateD」で統一)
5_フォルダE
　∟ファイルE_結果.xls
(Sheet名：A広域/B広域/C広域/D広域/E広域)

例えばコンボボックスで「2007」を選択した場合、
表【地域A男性】
「2006_ファイルA.xls」のC5～C23を「ファイルE_結果.xls」の(A広域)D7～D25にコピー
「2007_ファイルA.xls」のC5～C23を「ファイルE_結果.xls」の(A広域)E7～E25にコピー
「2008_ファイルA.xls」のC5～C23を「ファイルE_結果.xls」の(A広域)F7～F25にコピー
「2006_ファイルB.xls」のC5～C23を「ファイルE_結果.xls」の(A広域)H7～H25にコピー
「2007_ファイルB.xls」のC5～C23を「ファイルE_結果.xls」の(A広域)I7～I25にコピー
「2008_ファイルB.xls」のC5～C23を「ファイルE_結果.xls」の(A広域)J7～J25にコピー
「2007_ファイルC.xls」のC4～C22を「ファイルE_結果.xls」の(A広域)L7～L25にコピー
「2007_ファイルD.xls」のE8～E26を「ファイルE_結果.xls」の(A広域)N7～N25にコピー

表【地域A女性】
「2006_ファイルA.xls」のD5～D23を「ファイルE_結果.xls」の(A広域)D26～D44にコピー
「2007_ファイルA.xls」のD5～D23を「ファイルE_結果.xls」の(A広域)E26～E44にコピー
「2008_ファイルA.xls」のD5～D23を「ファイルE_結果.xls」の(A広域)F26～F44にコピー
「2006_ファイルB.xls」のC25～C43を「ファイルE_結果.xls」の(A広域)H26～H44にコピー
「2007_ファイルB.xls」のC25～C43を「ファイルE_結果.xls」の(A広域)I26～I44にコピー
「2008_ファイルB.xls」のC25～C43を「ファイルE_結果.xls」の(A広域)J26～J44にコピー
「2007_ファイルC.xls」のC24～C42を「ファイルE_結果.xls」の(A広域)L26～L44にコピー
「2007_ファイルD.xls」のE8～E26を「ファイルE_結果.xls」の(A広域)N26～N44にコピー

表【地域B男性】
「2006_ファイルA.xls」のF5～F23を「ファイルE_結果.xls」の(A広域)D51～D69にコピー
「2007_ファイルA.xls」のF5～F23を「ファイルE_結果.xls」の(A広域)E51～E69にコピー
「2008_ファイルA.xls」のF5～F23を「ファイルE_結果.xls」の(A広域)F51～F69にコピー
「2006_ファイルB.xls」のD5～D23を「ファイルE_結果.xls」の(A広域)H51～H69にコピー
「2007_ファイルB.xls」のD5～D23を「ファイルE_結果.xls」の(A広域)I51～I69にコピー
「2008_ファイルB.xls」のD5～D23を「ファイルE_結果.xls」の(A広域)J51～J69にコピー
「2007_ファイルC.xls」のD4～D22を「ファイルE_結果.xls」の(A広域)L51～L69にコピー
「2007_ファイルD.xls」のE8～E26を「ファイルE_結果.xls」の(A広域)N51～N69にコピー

表【地域B女性】
「2006_ファイルA.xls」のG5～G23を「ファイルE_結果.xls」の(A広域)D70～D88にコピー
「2007_ファイルA.xls」のG5～G23を「ファイルE_結果.xls」の(A広域)E70～E88にコピー
「2008_ファイルA.xls」のG5～G23を「ファイルE_結果.xls」の(A広域)F70～F88にコピー
「2006_ファイルB.xls」のD25～D43を「ファイルE_結果.xls」の(A広域)H70～H88にコピー
「2007_ファイルB.xls」のD25～D43を「ファイルE_結果.xls」の(A広域)I70～I88にコピー
「2008_ファイルB.xls」のD25～D43を「ファイルE_結果.xls」の(A広域)J70～J88にコピー
「2007_ファイルC.xls」のD24～D42を「ファイルE_結果.xls」の(A広域)L70～L88にコピー
「2007_ファイルD.xls」のE8～E26を「ファイルE_結果.xls」の(A広域)N70～N88にコピー

表【地域C男性】
「2006_ファイルA.xls」のC5～C23を「ファイルE_結果.xls」の(B広域)D7～D25にコピー
「2007_ファイルA.xls」のC5～C23を「ファイルE_結果.xls」の(B広域)E7～E25にコピー
「2008_ファイルA.xls」のC5～C23を「ファイルE_結果.xls」の(B広域)F7～F25にコピー
「2006_ファイルB.xls」のC5～C23を「ファイルE_結果.xls」の(B広域)H7～H25にコピー
「2007_ファイルB.xls」のC5～C23を「ファイルE_結果.xls」の(B広域)I7～I25にコピー
「2008_ファイルB.xls」のC5～C23を「ファイルE_結果.xls」の(B広域)J7～J25にコピー
「2007_ファイルC.xls」のC4～C22を「ファイルE_結果.xls」の(B広域)L7～L25にコピー
「2007_ファイルD.xls」のE8～E26を「ファイルE_結果.xls」の(B広域)N7～N25にコピー

表【地域C女性】
「2006_ファイルA.xls」のD5～D23を「ファイルE_結果.xls」の(B広域)D26～D44にコピー
「2007_ファイルA.xls」のD5～D23を「ファイルE_結果.xls」の(B広域)E26～E44にコピー
「2008_ファイルA.xls」のD5～D23を「ファイルE_結果.xls」の(B広域)F26～F44にコピー
「2006_ファイルB.xls」のC25～C43を「ファイルE_結果.xls」の(B広域)H26～H44にコピー
「2007_ファイルB.xls」のC25～C43を「ファイルE_結果.xls」の(B広域)I26～I44にコピー
「2008_ファイルB.xls」のC25～C43を「ファイルE_結果.xls」の(B広域)J26～J44にコピー
「2007_ファイルC.xls」のC24～C42を「ファイルE_結果.xls」の(B広域)L26～L44にコピー
「2007_ファイルD.xls」のE8～E26を「ファイルE_結果.xls」の(B広域)N26～N44にコピー

※「表【地域C女性】」等はワークシートの表のタイトルです。

'//////////////////////////////////////////////////////

回答No.3

cj_mover · ベストアンサー

' ' ///（３／投稿を３分割しています。）

' ' ■■■4_フォルダD
　　sWbkSubName = "4_フォルダD\" & vTgYear & "_ファイルD.xls"　 '　●
　　sShtName = "dateD"　'　●
　　On Error Resume Next
　　Set sht元データ = Workbooks.Open(sMyDir & sWbkSubName).Sheets(sShtName)
　　On Error GoTo 0
　　If sht元データ Is Nothing Then
　　　　sMsg = sMsg & vbLf & "ブック◆" & sWbkSubName & vbLf & vbTab & "◆シート◆" & sShtName
　　Else
　　　　With sht元データ
' ' 8) 地域A男 [2007_ファイルD.xls]dateD!E8:E26→A広域!N7:N25
　　　　　　shtA広域.Range("N7:N25").Value = .Range("E8:E26").Value　'　●
' ' 16) 地域A女 [2007_ファイルD.xls]dateD!E8:E26→A広域!N26:N44
　　　　　　shtA広域.Range("N26:N44").Value = .Range("E8:E26").Value　'　●
' ' 24) 地域B男 [2007_ファイルD.xls]dateD!E8:E26→A広域!N51:N69
　　　　　　shtA広域.Range("N51:N69").Value = .Range("E8:E26").Value　'　●
' ' 32) 地域B女 [2007_ファイルD.xls]dateD!E8:E26→A広域!N70:N88
　　　　　　shtA広域.Range("N70:N88").Value = .Range("E8:E26").Value　'　●
' ' 40) 地域C男 [2007_ファイルD.xls]dateD!E8:E26→B広域!N7:N25
　　　　　　shtB広域.Range("N7:N25").Value = .Range("E8:E26").Value　'　●
' ' 48) 地域C女 [2007_ファイルD.xls]dateD!E8:E26→B広域!N26:N44
　　　　　　shtB広域.Range("N26:N44").Value = .Range("E8:E26").Value　'　●
　　　　　　.Parent.Close SaveChanges:=False
　　　　End With
　　　　Set sht元データ = Nothing
　　End If

　　' ' "ファイルC_2006～2008年結果.xls"形式の名前を付け保存する
　　Application.DisplayAlerts = False
　　wbk結果.SaveAs Filename:=sMyDir & "5_フォルダE\" & ComboBox1.Value & "_ファイルE.xls" '　　●
　　Application.DisplayAlerts = True

　　With Application
　　　　.ScreenUpdating = True
　　　　.Calculation = xlCalculationAutomatic
　　End With
　　Set shtA広域 = Nothing:　　Set shtB広域 = Nothing:　　Set wbk結果 = Nothing

　　If sMsg = "" Then
　　　　MsgBox Label1.Caption & vbLf & "処理完了", vbInformation
　　Else
　　　　MsgBox sMsg & vbLf & "開くことが出来ませんでした", vbExclamation
　　End If
End Sub

' ' /// 以上です。

お礼

お世話になりました。自力で解決できました。ありがとうございました。

補足

ご回答いただきましてありがとうございました。やりたいことができたのですがコピーの内容が大きくなってしまい、「プロシージャが大きすぎます」となってしまい1つのプロシージャに収まりませんでした。そこで、2つに分けようと思ったのですが「すでに開いています。内容が破棄されます。」的なメッセージが出てしまい、前に入力された内容が保存されなくなってしまいました。コピー内容が多くなってしまい、プロシージャを2つに分けたい場合にはどうしたらよいでしょうか？私は、結果ファイルを開いておいてそこにコピーしていく方法を考え【http://okwave.jp/qa/q8508566.html】のようなコードを書いてみたのですが、エラーになってしまいました。もしご存じでしたらご教授いただけますと幸いです。

回答No.2

cj_mover

' ' ///（２／投稿を３分割しています。）

' ' ■■■2_フォルダB
　　　　sWbkSubName = "2_フォルダB\" & vTgYear + i & "_ファイルB.xls"　'　●
　　　　sShtName = "dateB"　'　●
　　　　On Error Resume Next
　　　　Set sht元データ = Workbooks.Open(sMyDir & sWbkSubName).Sheets(sShtName)
　　　　On Error GoTo 0
　　　　If sht元データ Is Nothing Then
　　　　　　sMsg = sMsg & vbLf & "ブック◆" & sWbkSubName & vbLf & vbTab & "◆シート◆" & sShtName
　　　　Else
　　　　　　With sht元データ
' ' 4) 地域A男 [2006_ファイルB.xls]dateB!C5:C23→A広域!H7:H25
' ' 5) 地域A男 [2007_ファイルB.xls]dateB!C5:C23→A広域!I7:I25
' ' 6) 地域A男 [2008_ファイルB.xls]dateB!C5:C23→A広域!J7:J25
　　　　　　　　shtA広域.Range("I7:I25").Offset(, i).Value = .Range("C5:C23").Value　'　●
' ' 12) 地域A女 [2006_ファイルB.xls]dateB!C25:C43→A広域!H26:H44
' ' 13) 地域A女 [2007_ファイルB.xls]dateB!C25:C43→A広域!I26:I44
' ' 14) 地域A女 [2008_ファイルB.xls]dateB!C25:C43→A広域!J26:J44
　　　　　　　　shtA広域.Range("I26:I44").Offset(, i).Value = .Range("C25:C43").Value　'　●
' ' 20) 地域B男 [2006_ファイルB.xls]dateB!D5:D23→A広域!H51:H69
' ' 21) 地域B男 [2007_ファイルB.xls]dateB!D5:D23→A広域!I51:I69
' ' 22) 地域B男 [2008_ファイルB.xls]dateB!D5:D23→A広域!J51:J69
　　　　　　　　shtA広域.Range("I51:I69").Offset(, i).Value = .Range("D5:D23").Value　'　●
' ' 28) 地域B女 [2006_ファイルB.xls]dateB!D25:D43→A広域!H70:H88
' ' 29) 地域B女 [2007_ファイルB.xls]dateB!D25:D43→A広域!I70:I88
' ' 30) 地域B女 [2008_ファイルB.xls]dateB!D25:D43→A広域!J70:J88
　　　　　　　　shtA広域.Range("I70:I88").Offset(, i).Value = .Range("D25:D43").Value　'　●
' ' 36) 地域C男 [2006_ファイルB.xls]dateB!C5:C23→B広域!H7:H25
' ' 37) 地域C男 [2007_ファイルB.xls]dateB!C5:C23→B広域!I7:I25
' ' 38) 地域C男 [2008_ファイルB.xls]dateB!C5:C23→B広域!J7:J25
　　　　　　　　shtB広域.Range("I7:I25").Offset(, i).Value = .Range("C5:C23").Value　'　●
' ' 44) 地域C女 [2006_ファイルB.xls]dateB!C25:C43→B広域!H26:H44
' ' 45) 地域C女 [2007_ファイルB.xls]dateB!C25:C43→B広域!I26:I44
' ' 46) 地域C女 [2008_ファイルB.xls]dateB!C25:C43→B広域!J26:J44
　　　　　　　　shtB広域.Range("I26:I44").Offset(, i).Value = .Range("C25:C43").Value　'　●
　　　　　　　　.Parent.Close SaveChanges:=False
　　　　　　End With
　　　　　　Set sht元データ = Nothing
　　　　End If

　　Next i

' ' ■■■3_フォルダC
　　sWbkSubName = "3_フォルダC\" & vTgYear & "_ファイルC.xls"　'　●
　　sShtName = "dateC"　'　●
　　On Error Resume Next
　　Set sht元データ = Workbooks.Open(sMyDir & sWbkSubName).Sheets(sShtName)
　　On Error GoTo 0
　　If sht元データ Is Nothing Then
　　　　sMsg = sMsg & vbLf & "ブック◆" & sWbkSubName & vbLf & vbTab & "◆シート◆" & sShtName
　　Else
　　　　With sht元データ
' ' 7) 地域A男 [2007_ファイルC.xls]dateC!C4:C22→A広域!L7:L25
　　　　　　shtA広域.Range("L7:L25").Value = .Range("C4:C22").Value　'　●
' ' 15) 地域A女 [2007_ファイルC.xls]dateC!C24:C42→A広域!L26:L44
　　　　　　shtA広域.Range(" L26:L44").Value = .Range("C24:C42").Value　'　●
' ' 23) 地域B男 [2007_ファイルC.xls]dateC!D4:D22→A広域!L51:L69
　　　　　　shtA広域.Range("L51:L69").Value = .Range("D4:D22").Value　'　●
' ' 31) 地域B女 [2007_ファイルC.xls]dateC!D24:D42→A広域!L70:L88
　　　　　　shtA広域.Range("L70:L88").Value = .Range("D24:D42").Value　'　●
' ' 39) 地域C男 [2007_ファイルC.xls]dateC!C4:C22→B広域!L7:L25
　　　　　　shtB広域.Range("L7:L25").Value = .Range("C4:C22").Value　'　●
' ' 47) 地域C女 [2007_ファイルC.xls]dateC!C24:C42→B広域!L26:L44
　　　　　　shtB広域.Range("L26:L44").Value = .Range("C24:C42").Value　'　●
　　　　　　.Parent.Close SaveChanges:=False
　　　　End With
　　　　Set sht元データ = Nothing
　　End If

' ' つづく

回答No.1

cj_mover

「今」混乱せずに先に進めるように、要領を示す意味で簡単ストレートな書き方を心掛けました。

ダミーサンプル（フォルダ ブック シート データ）すべて作成し動作確認済です。

以下、コメント先頭の数字は
直下の処理が、ご提示の対応表での何件めに対応しているか、を示しています。
ちょっと目的が判らない不自然な処理が指示されているようにも思えますが
対応関係を参照すれば混乱することはないでしょうから
ひとつひとつ確認しながら必要ならそちらで書換えるようにしてください。
（セル参照を修正する場合はコメントも直してください。）

' ' ///（１／投稿を３分割します。）

Private Sub CommandButton1_Click()　'　●　Re:　8488933　8503466　8504035　504383

Dim vTgYear As Variant
Dim wbk結果 As Workbook
Dim shtA広域 As Worksheet
Dim shtB広域 As Worksheet
Dim sht元データ As Worksheet
Dim sMyDir As String
Dim sWbkSubName As String
Dim sShtName As String
Dim sMsg As String
Dim i As Long

　　vTgYear = ComboBox1.Value　'　●
　　If Not vTgYear Like "####" Then
　　　　MsgBox "年次を指定してからやり直し", vbExclamation
　　　　Exit Sub
　　End If

　　Select Case vTgYear
　　Case 1999 To 2012　'　●
　　Case Else
　　　　MsgBox "1999～2012の間で年次を指定してからやり直し", vbExclamation　'　●
　　　　Exit Sub
　　End Select

　　sMyDir = ThisWorkbook.Path & "\"

　　With Application
　　　　.ScreenUpdating = False
　　　　.Calculation = xlCalculationManual
　　End With

　　' ' ファイルE_結果.xls を開く
　　sWbkSubName = "5_フォルダE\ファイルE_結果.xls"　'　●
　　On Error Resume Next
　　Set wbk結果 = Workbooks.Open(sMyDir & sWbkSubName)
　　On Error GoTo 0
　　If wbk結果 Is Nothing Then
　　　　MsgBox "ブック◆" & sWbkSubName & vbLf & "を開くことが出来ませんでした", vbExclamation
　　　　Exit Sub
　　End If

　　' ' ファイルE_結果.xls シート"A広域" を取得
　　sShtName = "A広域"　'　●
　　On Error Resume Next
　　Set shtA広域 = wbk結果.Sheets(sShtName)
　　On Error GoTo 0
　　If shtA広域 Is Nothing Then
　　　　MsgBox "ブック◆" & sWbkSubName & vbLf & vbTab & "◆シート◆" & sShtName & vbLf & "が見当たりません", vbExclamation
　　　　Set wbk結果 = Nothing
　　　　Exit Sub
　　End If

　　' ' ファイルE_結果.xls シート"B広域" を取得
　　sShtName = "B広域"　'　●
　　On Error Resume Next
　　Set shtB広域 = wbk結果.Sheets(sShtName)
　　On Error GoTo 0
　　If shtB広域 Is Nothing Then
　　　　MsgBox "ブック◆" & sWbkSubName & vbLf & vbTab & "◆シート◆" & sShtName & vbLf & "が見当たりません", vbExclamation
　　　　Set wbk結果 = Nothing
　　　　Exit Sub
　　End If

　　' ' 出力先のセル範囲を値消去　　テンプレートが空白なら、以下２行不要
　　shtA広域.Range("(7:44,51:88) (D:F,H:J,L:L,N:N)").ClearContents　'　●
　　shtB広域.Range("(7:44) (D:F,H:J,L:L,N:N)").ClearContents　'　●

　　' ' 前年～翌年、ループ
　　For i = -1 To 1

' ' ■■■1_フォルダA
　　　　sWbkSubName = "1_フォルダA\" & vTgYear + i & "_ファイルA.xls"　'　●
　　　　sShtName = "dateA"　'　●
　　　　On Error Resume Next
　　　　Set sht元データ = Workbooks.Open(sMyDir & sWbkSubName).Sheets(sShtName)
　　　　On Error GoTo 0
　　　　If sht元データ Is Nothing Then
　　　　　　sMsg = sMsg & vbLf & "ブック◆" & sWbkSubName & vbLf & vbTab & "◆シート◆" & sShtName
　　　　Else
　　　　　　With sht元データ
' ' 1) 地域A男 [2006_ファイルA.xls]dateA!C5:C23→A広域!D7:D25
' ' 2) 地域A男 [2007_ファイルA.xls]dateA!C5:C23→A広域!E7:E25
' ' 3) 地域A男 [2008_ファイルA.xls]dateA!C5:C23→A広域!F7:F25
　　　　　　　　shtA広域.Range("E7:E25").Offset(, i).Value = .Range("C5:C23").Value　'　●
' ' 9) 地域A女 [2006_ファイルA.xls]dateA!D5:D23→A広域!D26:D44
' ' 10) 地域A女 [2007_ファイルA.xls]dateA!D5:D23→A広域!E26:E44
' ' 11) 地域A女 [2008_ファイルA.xls]dateA!D5:D23→A広域!F26:F44
　　　　　　　　shtA広域.Range("E26:E44").Offset(, i).Value = .Range("D5:D23").Value　'　●
' ' 17) 地域B男 [2006_ファイルA.xls]dateA!F5:F23→A広域!D51:D69
' ' 18) 地域B男 [2007_ファイルA.xls]dateA!F5:F23→A広域!E51:E69
' ' 19) 地域B男 [2008_ファイルA.xls]dateA!F5:F23→A広域!F51:F69
　　　　　　　　shtA広域.Range("E51:E69").Offset(, i).Value = .Range("F5:F23").Value　'　●
' ' 25) 地域B女 [2006_ファイルA.xls]dateA!G5:G23→A広域!D70:D88
' ' 26) 地域B女 [2007_ファイルA.xls]dateA!G5:G23→A広域!E70:E88
' ' 27) 地域B女 [2008_ファイルA.xls]dateA!G5:G23→A広域!F70:F88
　　　　　　　　shtA広域.Range("E70:E88").Offset(, i).Value = .Range("G5:G23").Value　'　●
' ' 33) 地域C男 [2006_ファイルA.xls]dateA!C5:C23→B広域!D7:D25
' ' 34) 地域C男 [2007_ファイルA.xls]dateA!C5:C23→B広域!E7:E25
' ' 35) 地域C男 [2008_ファイルA.xls]dateA!C5:C23→B広域!F7:F25
　　　　　　　　shtB広域.Range("E7:E25").Offset(, i).Value = .Range("C5:C23").Value　'　●
' ' 41) 地域C女 [2006_ファイルA.xls]dateA!D5:D23→B広域!D26:D44
' ' 42) 地域C女 [2007_ファイルA.xls]dateA!D5:D23→B広域!E26:E44
' ' 43) 地域C女 [2008_ファイルA.xls]dateA!D5:D23→B広域!F26:F44
　　　　　　　　shtB広域.Range("E26:E44").Offset(, i).Value = .Range("D5:D23").Value　'　●
　　　　　　　　.Parent.Close SaveChanges:=False
　　　　　　End With
　　　　　　Set sht元データ = Nothing
　　　　End If

' ' つづく