6人分の物件表を1つのbookに自動的にまとめたい

質問

エクセルで作られた5人分の物件表(商品名、売値、原価、確度が入力されている）があります。この5つのbookを自動的にひとつのbook(5人分のデータが入ったbook）にまとめたいのですが、どうしたらよいかわかりません。
全体の物件表には既にデータがかなりの行数入っています。
1行目から50行目までは(1)さん、(2)さん、(3)さん、(4)さん、(5)さんの確度A(受注確実）の物件が、51行目から100行目まではそれぞれの人達の確度B (ほぼ受注確実）の物件、それ以降の行には確度C,D,Eの物件が入っています。
5人それぞれの物件表と、全体の物件表のフォーマットはまったく一緒です。
まだ、マクロはほんの少ししか使えません。
どうしたらよいのかまったくわからないので、どなたかいい方法がわかる方がいたら教えてください。お願いします。
この説明がわかりづらければ補足説明しますので、ご質問ください。

回答No.8

kazuhiko5681 · ベストアンサー

こんばんわ。ごめんなさい。また記述ミスです。今度は、動作確認をしたので、きちんと動作すると思います。

Private Sub Worksheet_Change(ByVal Target As Range)

Dim myWb As Workbook
Dim myWbn As String
Dim myRow1 As Long
Dim myWsn As Worksheet
Dim myAdr As String
Dim myRow2 As Long

myRow1 = Target.Row
If Range("K" & myRow1).Value = "" Then Exit Sub

For Each myWb In Workbooks
If myWb.Name = "受注管理.xls" Then
myWbn = myWb.Name: Exit For
End If
Next myWb
If myWbn <> "受注管理.xls" Then
Workbooks.Open Filename:="C:\My Documents\受注管理.xls"
End If

Set myWsn = Workbooks("受注管理.xls").Worksheets(1)
myAdr = Range("B" & myRow1).End(xlToRight).Offset(0, -1).Address
MsgBox myAdr
myRow2 = myWsn.Cells(Rows.Count, 2).End(xlUp).Row
Range("B" & myRow1 & ":" & myAdr).Copy Destination:=myWsn.Range("B" & myRow2 + 1)

End Sub

お礼

この度は大変ありがとうございました＆お手数おかけいたしました。
無事思い通りのファイルにすることができました。
1年でこんなにVBAを使いこなせるようになるなんてすごいですね。
私も早く一人前になれるよう精進したいと思います。
もしまた何かありましたらよろしくお願い致します。

回答No.7

kazuhiko5681

こんばんわ。大変申し訳ございませんでした。マクロの記述ミスです。修正マクロを作りました。前回のように操作してみて下さい。

Private Sub Worksheet_Change(ByVal Target As Range)

Dim myWb As Workbook
Dim myWbn As String
Dim myRow1 As Long
Dim myWsn As Worksheet
Dim myAdr As String
Dim myRow2 As Long

myRow1 = Target.Row
If Range("K" & myRow1).Value = "" Then Exit Sub

For Each myWb In Workbooks
If myWb.Name = "受注管理.xls" Then
myWbn = myWb.Name: Exit For
End If
Next myWb
If myWbn <> "受注管理.xls" Then
Workbooks.Open Filename:="C:\My Documents\受注管理.xls"
End If

Set myWsn = Workbooks("受注管理.xls").Worksheets(1)
myAdr = Range("B" & myRow1).End(xlToRight).Offset(0, -1).Address
MsgBox myAdr
myRow2 = myWsn.Cells(Rows.Count, 1).End(xlUp).Row
Range("B" & myRow & ":" & myAdr).Copy Destination:=myWsn.Range("B" & myRow2 + 1)

End Sub

これで、うまく動作すると思います。
それから本のことですが、本屋さんではなくラオックス等コンピューターを扱っている店舗の書籍コーナーにあると思います。私も、本屋さんでは見たことがありません。私は、ラオックスで買いました。

貴方様もお体をご自愛下さい。

補足

何度もすみません。
早速修正プログラムをコピー＆ペーストしてみました。
ところが、追加した行が前の行に上書きされてしまいました。
頼りっぱなしで申し訳ありませんが、ご教授ください、
お願いします。

回答No.6

kazuhiko5681

こんばんわ。データの最終列のすぐ隣(Ｊ列までデータが入力されていればＫ列)に文字・記号等を入力した時に、受注管理ブックのシート１のＢ列より右にデータを反映するようにマクロを修正してみました。前回のように下記のコードを貼り付けて確認してみて下さい。

Private Sub Worksheet_Change(ByVal Target As Range)

Dim myWb As Workbook
Dim myWbn As String
Dim myRow1 As Long
Dim myWsn As Worksheet
Dim myAdr As String
Dim myRow2 As Long

myRow1 = Target.Row
If Range("K" & myRow1).Value = "" Then Exit Sub

For Each myWb In Workbooks
If myWb.Name = "受注管理.xls" Then
myWbn = myWb.Name: Exit For
End If
Next myWb
If myWbn <> "受注管理.xls" Then
Workbooks.Open Filename:="C:\My Documents\受注管理.xls"
End If

Set myWsn = Workbooks("受注管理.xls").Worksheets(1)
myAdr = Range("B" & myRow1).End(xlToRight).Offset(0, -1).Address
MsgBox myAdr
myRow2 = myWsn.Cells(Rows.Count, 1).End(xlUp).Row
Range("B2:" & myAdr).Copy Destination:=myWsn.Range("B" & myRow2 + 1)

End Sub

後ご質問にお答えいたします。
貴方様は、どうもモジュールがプログラムを実行させるとお考えになっておられるようですが、プログラムを実行させるのはコードです。コードを書くためのシートのことをモジュールと呼び、モジュールに書かれたコードの集まりがプログラムなのです。

Set myWsn = Workbooks("受注管理.xls").Worksheets(1)
setは、変数にオブジェクトを代入する時に使う命令語
このコードは、変数myWsnに受注管理というブックのワークシート１というオブジェクトを代入するという動作をさせるためのコードです。

myRow2 = myWsn.Cells(Rows.Count, 1).End(xlUp).Row
Rows.Countはシートの最終行を取得する時に使う。
このコードは、データが入力されている最終行の行番号をmyRow2に代入するという動作をさせるためのコードです。

詳しいことをお知りになりたい時は、次の本を読んでみて下さい。ＶＢＡのことが詳しくわかりやすく書かれています。わたしもこの本で勉強してここまでコードを約１年位で書けるようになりました。
簡単プログラミングエクセル２０００ＶＢＡ(基礎編・関数偏・応用編)
著者：大村あつし　出版社：技術評論者

また、解らないことがありましたら、ご遠慮なくお知らせ下さい。

補足

こんばんわ。 修正プログラムを作っていただきありがとうございました。
しかし！！残念ながら、追加したい行だけでなく、1行目からのすべての行が
追加されてしまいました・・・
何が原因なのでしょうか？
ところで、早速、ご推薦されたプログラミングエクセル２０００ＶＢＡ(基礎編・関数偏・応用編) を買おうと思い、本屋さんに行ってみたところ、地元の本屋さんには置いていませんでした。。。。。
明日は大きな本屋さんに行ってみます。
寒くなってきたので、風邪には気をつけてください。
それでは。

回答No.5

kazuhiko5681

こんばんわ。修正マクロを作ってみました。前回のように操作してみて下さい。

Private Sub Worksheet_Change(ByVal Target As Range)

Dim myWb As Workbook
Dim myWbn As String
Dim myRow1 As Long
Dim myWsn As Worksheet
Dim myRow2 As Long

myRow1 = Target.Row
If Range("J" & myRow1).Value = "" Then Exit Sub

For Each myWb In Workbooks
If myWb.Name = "受注管理.xls" Then
myWbn = myWb.Name: Exit For
End If
Next myWb
If myWbn <> "受注管理.xls" Then
Workbooks.Open Filename:="受注管理.xls"
End If

Set myWsn = Workbooks("受注管理.xls").Worksheets(1)
myRow2 = myWsn.Cells(Rows.Count, 1).End(xlUp).Row
Rows(myRow1 & ":" & myRow1).Copy Destination:=myWsn.Rows(myRow2 + 1 & ":" & myRow2 + 1)

End Sub

補足

何度も何度も本当にありがとうございます。
ご迷惑かけついでに、あと一回だけご教授下さい。
Ａ列には続き番号が入っているので、できれば、B行からのデータを、
受注管理のファイルに反映したいのですが、どうしたらよいのでしょうか？
そして、データを反映させるかさせないかを選択性にすることはできますか？
どんな方法でもよいのですが、例えば反映させたくない行の最初にチェックを入れると受注管理のファイルにデータを反映させないというように。
後、最後から４番目と５番目の行の
Set myWsn = Workbooks("受注管理.xls").Worksheets(1)
myRow2 = myWsn.Cells(Rows.Count, 1).End(xlUp).Row
がどのようなプログラムを実行するためのモジュールなのかわかりません。
周りにVBAがわかる人がいないので、一人で悶々と悩んでおります。
ずーずーしいお願いで申し訳ありません。もし、面倒くさくないようでしたらお教えください。
お願い致します。

回答No.4

kazuhiko5681

こんにちは。早速サンプルマクロを組んでみました。もしかしたら、あなた様がイメージしているのと違う動作になってしまうかもしれませんが、次のように操作し、確認してみて下さい。もし動作が違う場合は、どこが違うのか具体的に詳しくお知らせ下さい。修正マクロを作ってみたいと思います。

１.新規ブックを開き、シート１のＡ１０～Ｊ１０に項目名を入力する。
２.ブック名を受注管理としてマイドキュメントに保存終了する。(ウインドウズがXPの時は、個人のマイドキュメントではなく、全体のマイドキュメントへ保存終了する。)
３.再度新規ブックを開き、ＡＬＴ＋Ｆ１１キーを押してＶＢＥ画面を開く
４.画面左上のVBAProject徒書いてある下のSheet1をダブルクリックし、右側の白い部分へ下のコードをコピー・ペーストする。
５.次のように操作してみる。
　・シート１のＡ１０～Ｊ１０に項目名を入力する。
　・シート１のＡ１１～Ｊ１１にデータを入力する。

Ｊ１１のデータを入力し終えた時点で、自動的にブック(受注管理)が開かれ、このブックの・シート１のＡ１１～Ｊ１１にデータが入力されています。

Private Sub Worksheet_Change(ByVal Target As Range)

Dim myWb As Workbook
Dim myWbn As String
Dim myRow1 As Long
Dim myWsn As Worksheet
Dim myRow2 As Long

For Each myWb In Workbooks
If myWb.Name = "受注管理.xls" Then
myWbn = myWb.Name: Exit For
End If
Next myWb
If myWbn <> "受注管理.xls" Then
Workbooks.Open Filename:="受注管理"
End If

myRow1 = Target.Row
If Target.Address = Range("J" & myRow1).Address Then
Set myWsn = Workbooks("受注管理.xls").Worksheets(1)
myRow2 = myWsn.Cells(Rows.Count, 1).End(xlUp).Row
Rows(myRow1 & ":" & myRow1).Copy Destination:=myWsn.Rows(myRow2 + 1 & ":" & myRow2 + 1)
End If

End Sub

お手数をおかけいたしますが、よろしくお願いいたします。

お礼

丁寧なご回答どうもありがとうございました。
大変、大変助かりました。
ほぼ理想通りのファイルが出来上がりました。
ただ、キーボードから入力するとデータは反映されるのですが、
コピー＆ペーストでデータを入力すると、"物件表"の方のファイルにデータが
反映されません。まったく同じデータが多数あるので、コピー＆ペーストで
データが入力できるとありがたいのですが・・・
もし、原因がわかるようでしたらお教え下さい。お願いします。

回答No.3

kazuhiko5681

こんばんわ。早速の補足有難うございます。
まだよく全体像がつかめないので再度補足の要求をさせていただきます。
Ａ１０：客先名、Ｂ１０：物件名、Ｃ１０：担当、Ｄ１０：確度、Ｅ１０：物件番号、Ｆ１０：売値、Ｇ１０：原価、Ｈ１０：荒利、Ｉ１０：受注月、Ｊ１０：売上げ月と項目名がなっているのはわかりました。では、１行目から９行目まではどの様になっているのでしょうか。

＞この5つのbookを自動的にひとつのbook(5人分のデータが入ったbook）にま＞とめたい。
ということなのですが、他のそれぞれのブックの項目名や表の構成はどのようになっているのでしょうか。

今ひとつあなた様のおやりになりたいことが頭に浮かんできません。
あなた様のおやりになりたいことをもう一度具体的に詳しくお知らせいただけないでしょうか。それが解らないとマクロを組むことができません。

お手数をおかけいたしますが、よろしくお願いいたします。

補足

1行目から9行目には下記のデータが入っています。(千円単位）グループ全体の売上げです。

受注額 受注マージン　 売上額 　売上マージン
--------------------------------------------------
A 10000 1000　　　　20000　　200
--------------------------------------------------
B 10000　　1000　　　　20000　　200
---------------------------------------------------
C 10000　　1000　　　　・・・　　　・・・
---------------------------------------------------
D 20000　　2000 ・・・
--------------------------------------------------
E 1500　　 150　　　　・・・
---------------------------------------------------
F 2000 200
-----------------------------------------------------
S 1000 100
------------------------------------------------------
A+B+C 54500 5450
------------------------------------------------------
たとえば(1)さんが自分のブックの最終行に新しい物件（原価、確度など）を追加したら、全体の方のブックの最終行(300行目）に(1)さんのデータが自動的に入力されるようにしたいのです。
そして、(2)さんが新たに自分のブックにデータを入力したら全体のブックの方の(1)さんの物件の下(301行目）に(2)さんのデータが自動的に入力されるようにしたいのです。(300行目には既に(1)さんのデータが自動的に入っている）
つまり、全体のブックは、グループ全体でどれだけの物件数と売上げがあったのか、一目でわかるようにしたいのです。
個人が自分の物件表を更新したら、全体の物件表も、その更新を反映するようにしたいのですが、そんなことってできますか？
うまく伝えられなくてもどかしいのですが、もし、まだわからなければ聞いてください。お願いします。
上の表のスペースがうまく表示されなくてわかりづらいかもしれませんが、確度ごとの売上げです。

回答No.2

adol37

一つのBOOKにまとめるということですが、シートは分かれていてもいいんでしょうか？
Excelでは複数のシートを１つのBookに納めて１ファイルに保存できます。
標準では３枚のシートで一つのBOOKが構成されていると思います。
では具体的な手順ですが、まず５人分のBOOKを開き、次にまとめたい新しいBOOKを作ってください。
その後、まず(1)さんのBOOKを選択し、画面の下にあるシートタブ（名前をつけてなければSheet1になってます）を右クリックし、表示されるメニューから「移動またはコピー」を選択します。
表示されるダイアログの一番下の「コピーを作成する」に必ずチェックを入れ、まとめたいBOOKを上のコンボボックスから選択します。
そのままOKをクリックするとまとめたいBOOKにシートがコピーされます。
これを残りのメンバーに対して繰り返せば、一つのBOOKにまとまります。
もし、１枚のシートにしたいということであれば、細かくコピー＆ペーストするか、マクロを組む必要がありますね。

回答No.1

kazuhiko5681

初めまして。私でよろしければコピー・ペーストするだけですぐにあなた様の思い通りに動作するサンプルマクロを組んでみたいと思います。
ご希望の節は、次のことをお知らせください。

　・現在データが入力されているシートの項目名とセル番地
　・移動するブックの項目名とセル番地

お手数をおかけいたしますが、よろしくお願いいたします。

お礼

わざわざ、ご丁寧なご回答ありがとうございます。
実は項目名はいっぱいあって、Ａ１０：客先名、Ｂ１０：物件名、Ｃ１０：担当、Ｄ１０：確度、Ｅ１０：物件番号、Ｆ１０：売値、Ｇ１０：原価、Ｈ１０：荒利、Ｉ１０：受注月、Ｊ１０：売上げ月です。
移動するBOOKには同じセル番地に同じ項目名が入っています。
この回答で、質問に対する答えになっていますか？
わからなければ、お手数ですが、ご質問ください。