【VBA】3個のワークブックから同時にシートをコピーしたい

Question

お世話になっております。

表題の通り、マクロのボタン一発で3個のワークブックから同時に
ワークシートをコピーしたいと思っております。

すいませんが詳しい方、説明の上手な方、直接、コードで説明できる方、
お手数ですが教えて下さい。よろしくお願いします。

具体的には以下のような感じです。
説明が下手ですいませんが、よろしくお願いします。

----------------

注文リストからの受注を3人の作業者で製作しております。
そのため注文リストを3枚プリントして作業者に配布しております。

作業中～完了後に3人の作業者が集まって、
それぞれの注文リストを見せ合い、
作りもれがないかを確認しております。

ですが現場でタブレット端末を利用しているため、
このチェック作業をエクセルのファイルで行おうと思っております。
以下のように考えております。

１）先の説明の通り工場の現場にタブレット端末があり、
WiFiでサーバーとやり取りしております。

２）ワークブックはサーバー上に置きます。

３）作業者が使うワークブック／ワークシートの
名前は以下の通りです。

ワークブック		ワークシート　

注文リスト-佐藤		10-24-佐藤
注文リスト-田中		10-24-田中
注文リスト-山本		10-24-山本

４）ワークシートをまとめるワークブックの名前

注文リスト-まとめ-10-24
↓
このワークブックにボタン一発でワークシート
10-24-佐藤、10-24-田中、10-24-山本　をコピーしたいです。

５）前述の通りワークブックはサーバー上にあります。
ですがコードを書く時は便宜上、フォルダー「A」が
「C:」にあるということでお願いします。

ファイルパスは「C:\A」です。
※ファイルパスはこちらで書き換えます。
例）
C:\A\注文リスト-佐藤.xlsm　という感じです。

わかると思います

すいませんがよろしくお願いします。

tatsu99 · Accepted Answer

以下のマクロを標準モジュールへ登録してください。
-----------------------------------------------------------
Option Explicit
Public Const dirName As String = "d:\goo\excel\goo33"

'３つのワークブックからシートをコピーする
Public Sub CopySheets()
    Dim dirName As String
    Dim trgbooks As Variant
    Dim trgsheets As Variant
    Dim i As Long
    trgbooks = Array("注文リスト-佐藤.xlsm", "注文リスト-田中.xlsm", "注文リスト-山本.xlsm")
    trgsheets = Array("10-24-佐藤", "10-24-田中", "10-24-山本")
    For i = 0 To UBound(trgbooks)
        'sheetの取り込み
        Call GetSheet(trgbooks(i), trgsheets(i))
    Next
End Sub
'指定ブックの指定シートを取り込む
Public Sub GetSheet(ByVal bookName As String, ByVal SheetName As String)
    Dim fullName As String
    Dim myBook As String
    Dim mySheet As String
    myBook = ThisWorkbook.Name
    mySheet = Worksheets(1).Name
    If ExistsWorkSheet(SheetName) Then
        Application.DisplayAlerts = False       'シート削除時の警告を出さないようにする
        Worksheets(SheetName).Delete            '既に該当シートがあるなら削除する
        Application.DisplayAlerts = True        'シート削除時の警告を出すようにする（元に戻す）
    End If
    fullName = dirName & "\" & bookName
    If Dir(fullName) = "" Then
        MsgBox (fullName & "は存在しません")
        Exit Sub
    End If
    Workbooks.Open fullName
    Workbooks(bookName).Activate
    If ExistsWorkSheet(SheetName) = False Then
        MsgBox (bookName & "中に" & SheetName & "は存在しません")
        Workbooks(bookName).Close
        Exit Sub
    End If
    Worksheets(SheetName).Copy after:=Workbooks(myBook).Worksheets(mySheet)
    Workbooks(bookName).Close
    Workbooks(myBook).Activate
    MsgBox (bookName & "中の" & SheetName & "をコピー完了")
End Sub
'ワークシートの存在チェック
Public Function ExistsWorkSheet(ByVal SheetName As String) As Boolean
    Dim ws As Worksheet
    ExistsWorkSheet = False
    For Each ws In Worksheets
        If ws.Name = SheetName Then
            ExistsWorkSheet = True
            Exit Function
        End If
    Next ws
End Function
-----------------------------------------------
マクロ CopySheets　を実行するとコピーできます。
使用時の注意事項は以下の通りです。
１．Public Const dirName As String = "d:\goo\excel\goo33"
が、３つのブックの存在するディレクトリです。（C:\Aに相当です）あなたの環境に
あわせてください。ディレクトリの最後に\はつけないでください。

２．注文リスト-まとめ-10-24中に
作業用のシート(sheet1等、名前は任意）を１つ以上、確保しておいてください。
そのシートの右側に、10-24-佐藤、10-24-田中、10-24-山本
をコピーします。
（10-24-佐藤、10-24-田中、10-24-山本だけのブックにしないでください。
作業用のシート(sheet1等）が最低１つないとコピー時エラーが発生します）

tatsu99 · Answer

補足要求です。
注文リスト-まとめ-10-24中に取り込みますが、すでに、このブック中に
10-24-佐藤
10-24-田中
10-24-山本
が存在したとき、このシートの取り込みをスキップしますか？
それとも、上書きしますか？（実際は削除してから取り込みます）

銀鱗 · Answer

なぜそのような面倒な処理を、都度行わなければならないのか。
初めから各Bookのシートを結合したBookを作成しておき、それを参照すればよいと思う。

・・・
ワークシートのコピーのコードが分からないのであれば、
「記録マクロ」を使ってコードの確認をしてみましょう。
（ワークシートのコピー（複製）のやり方は分かりますよね）

・・・余談・・・
全部作ってもらうと、仕様が変更になった時に他人に頼らないとならなくなります。
まったくの第三者に（しかもこのような場所で公に）それを示すことができるのであれば、
まあ問題はないでしょうが、必ず正しい答えが返ってくるとは限りません。

自身で分からない点をピンポイントで質問し、自力で作成するようにしてみよう。

【VBA】3個のワークブックから同時にシートをコピーしたい

以下のマクロを標準モジュールへ登録してください。

補足要求です。

なぜそのような面倒な処理を、都度行わなければならないのか。

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

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

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

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