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

Question

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

kazuhiko5681 · Accepted Answer

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

kazuhiko5681 · Answer

こんばんわ。大変申し訳ございませんでした。マクロの記述ミスです。修正マクロを作りました。前回のように操作してみて下さい。

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 

これで、うまく動作すると思います。
それから本のことですが、本屋さんではなくラオックス等コンピューターを扱っている店舗の書籍コーナーにあると思います。私も、本屋さんでは見たことがありません。私は、ラオックスで買いました。

貴方様もお体をご自愛下さい。

kazuhiko5681 · Answer

こんばんわ。データの最終列のすぐ隣(Ｊ列までデータが入力されていればＫ列)に文字・記号等を入力した時に、受注管理ブックのシート１のＢ列より右にデータを反映するようにマクロを修正してみました。前回のように下記のコードを貼り付けて確認してみて下さい。

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に代入するという動作をさせるためのコードです。

詳しいことをお知りになりたい時は、次の本を読んでみて下さい。ＶＢＡのことが詳しくわかりやすく書かれています。わたしもこの本で勉強してここまでコードを約１年位で書けるようになりました。
簡単プログラミングエクセル２０００ＶＢＡ(基礎編・関数偏・応用編)
著者：大村あつし　出版社：技術評論者

また、解らないことがありましたら、ご遠慮なくお知らせ下さい。

kazuhiko5681 · Answer

こんばんわ。修正マクロを作ってみました。前回のように操作してみて下さい。

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

kazuhiko5681 · Answer

こんにちは。早速サンプルマクロを組んでみました。もしかしたら、あなた様がイメージしているのと違う動作になってしまうかもしれませんが、次のように操作し、確認してみて下さい。もし動作が違う場合は、どこが違うのか具体的に詳しくお知らせ下さい。修正マクロを作ってみたいと思います。

１.新規ブックを開き、シート１のＡ１０～Ｊ１０に項目名を入力する。
２.ブック名を受注管理としてマイドキュメントに保存終了する。(ウインドウズが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

お手数をおかけいたしますが、よろしくお願いいたします。

kazuhiko5681 · Answer

こんばんわ。早速の補足有難うございます。
まだよく全体像がつかめないので再度補足の要求をさせていただきます。
Ａ１０：客先名、Ｂ１０：物件名、Ｃ１０：担当、Ｄ１０：確度、Ｅ１０：物件番号、Ｆ１０：売値、Ｇ１０：原価、Ｈ１０：荒利、Ｉ１０：受注月、Ｊ１０：売上げ月と項目名がなっているのはわかりました。では、１行目から９行目まではどの様になっているのでしょうか。

＞この5つのbookを自動的にひとつのbook(5人分のデータが入ったbook）にま＞とめたい。
ということなのですが、他のそれぞれのブックの項目名や表の構成はどのようになっているのでしょうか。

今ひとつあなた様のおやりになりたいことが頭に浮かんできません。
あなた様のおやりになりたいことをもう一度具体的に詳しくお知らせいただけないでしょうか。それが解らないとマクロを組むことができません。

お手数をおかけいたしますが、よろしくお願いいたします。

adol37 · Answer

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

kazuhiko5681 · Answer

初めまして。私でよろしければコピー・ペーストするだけですぐにあなた様の思い通りに動作するサンプルマクロを組んでみたいと思います。
ご希望の節は、次のことをお知らせください。

　・現在データが入力されているシートの項目名とセル番地
　・移動するブックの項目名とセル番地

お手数をおかけいたしますが、よろしくお願いいたします。

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

こんばんわ。

こんばんわ。

この回答への補足

こんばんわ。

この回答への補足

こんばんわ。

この回答への補足

こんにちは。

こんばんわ。

この回答への補足

一つのBOOKにまとめるということですが、シートは分かれていてもいいんでしょうか？

初めまして。

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング