こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

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

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


Sub 集計()

Workbooks.Open Filename:="C:\Documents and Settings\デスクトップ\H22.12月度\A店.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("A店.xls").Activate
Range("E5").Select
Application.CutCopyMode = False
ActiveWindow.Close
    ・
    ・
    ・(B・C・D店も同じ記述)
    ・
    ・
  Workbooks.Open Filename:="C:\Documents and Settings\デスクトップ\H22.12月度\E店.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("E店.xls").Activate
Range("E5").Select
Application.CutCopyMode = False
ActiveWindow.Close
  
Windows("集計.xls").Activate
Application.WindowState = xlMaximized
Range("E5").Select

End Sub

投稿日時 - 2010-12-15 11:54:59

QNo.6385960

困ってます

質問者が選んだベストアンサー

#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

投稿日時 - 2010-12-16 21:52:42

お礼

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

投稿日時 - 2010-12-23 20:26:11

このQ&Aは役に立ちましたか?

2人が「このQ&Aが役に立った」と投票しています

-広告-
-広告-

回答(2)

ANo.1

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

投稿日時 - 2010-12-15 13:39:04

-広告-
-広告-

あなたにオススメの質問

-広告-
-広告-