ＶＢＡでブックの集計の仕方を教えてください。

質問

Ｈ22.12月度と言う名前のフォルダーにＡ店～Ｅ店と集計と言う名前のブックがあります。
集計のブックでＡ店～Ｅ店の集計をしてくるマクロを組んでいますが上手く作動しません。
集計のブックには、セルの書式設定をしていますので、Ａ店～Ｅ店の売上一覧のシートから
値だけをコピーして集計したいのですが、罫線やパターン、数式までコピーしてきたり、
最後のＥ店だけ２重にコピーしてきたりと変な動作をします。
初心者で本やネットで調べながら作ったので、どこの記述がおかしくて、そうなるのかがさっぱりわかりません。
どなたか教えていただけませんでしょうか。よろしくお願いします。

Sub 集計()

Workbooks.Open Filename:="C:\Documents and Settings\デスクトップ\H22.12月度\Ａ店.xls"
Sheets("売上一覧").Select
Range("E5:Q24").Select
Selection.Copy
Application.WindowState = xlMinimized
Windows("集計.xls").Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
If Range("E5").Value <> "" Then
Range("E65536").Select
Selection.End(xlUp).Select
Selection.Offset(1, 0).Select
End If
ActiveSheet.Paste
Windows("Ａ店.xls").Activate
Range("E5").Select
Application.CutCopyMode = False
ActiveWindow.Close
　　　　・
　　　　・
　　　　・（Ｂ・Ｃ・Ｄ店も同じ記述)
　　　　・
　　　　・
　　Workbooks.Open Filename:="C:\Documents and Settings\デスクトップ\H22.12月度\Ｅ店.xls"
Sheets("売上一覧").Select
Range("E5:Q24").Select
Selection.Copy
Application.WindowState = xlMinimized
Windows("集計.xls").Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
If Range("E5").Value <> "" Then
Range("E65536").Select
Selection.End(xlUp).Select
Selection.Offset(1, 0).Select
End If
ActiveSheet.Paste
Windows("Ｅ店.xls").Activate
Range("E5").Select
Application.CutCopyMode = False
ActiveWindow.Close

Windows("集計.xls").Activate
Application.WindowState = xlMaximized
Range("E5").Select

End Sub

回答No.2

mitarashi · ベストアンサー

#1です。おまけです。
サブルーチン化すると、コードが短くて済みます。ご参考まで。
testの方を実行させて下さい。

Sub test()
testsub "C:\hogehoge","BookA.xls"
testsub "C:\hogehoge","BookB.xls"
以下別の集計元ファイルについて同様に記述。
End Sub

Sub testsub(myFolderName As String, myfileName As String)
Workbooks.Open Filename:=myFolderName & "\" & myfileName
Sheets("Sheet1").Select
Range("B6：F25").Select
Selection.Copy
Windows("Book1.xls").Activate
Sheets("Sheet1").Select
Range("B6").Select
If Range("B6").Value <> "" Then
Range("B65536").Select '2003以前の場合
Selection.End(xlUp).Select
Selection.Offset(1, 0).Select
End If
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows(myfileName).Activate
Application.CutCopyMode = False
ActiveWorkbook.Close savechanges:=False
End Sub

お礼

回答ありがとうございます
返事が遅くなってごめんなさい
いろいろ試してみましたけど、なかなかうまく行かなくて、年末が近づいて他の事で忙しくなるし。。。
今年中には出来上がりそうに無いですけど、せっかく回答もらったのでなんとかしたいなとは思います。

回答No.1

mitarashi

q6370420で回答した者ですが、今日はたまたま家でごろごろしておりますので．．．
頑張っていらっしゃる様子がうかがえますので、最小限の助言に止めておきますが、
値複写のコードと、丸ごとコピーのコードをダブって実行してしまっております。
先に回答したのは、丸ごとコピーですので、値複写に差し替えてください。
それでは、健闘を祈ります。
Sub test()
Windows("Book1.xls").Activate
Sheets("Sheet2").Select
Range("B6：F25").Select
Selection.Copy
Windows("Book2.xls").Activate
Sheets("Sheet1").Select
Range("B6").Select
If Range("B6").Value <> "" Then
Range("B65536").Select '2003以前の場合
Selection.End(xlUp).Select
Selection.Offset(1, 0).Select
End If
'activesheet.pasteの代わりに値複写のコードを記述
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub