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

解決済みの質問

EXCEL 別シートのコピー(3)

こんにちは。
こちらで以前こちらで質問をさせていただき、EXCELの別ブックのシートからコピーをしています。
元のブックのコピーを作り、そこに入力してもらい、元のブックにコピーをしています。(同じフォルダに入れて)

Private Sub CommandButton1_Click()

Dim myBook As Workbook

Set myBook = Workbooks.Open(ThisWorkbook.Path & "\コピー元ブック.xls") 
with workbooks("コピー元ブック.xls").worksheets("シート名").usedrange
workbooks("貼り付け先ブック.xls").worksheets("シート名").range(.address).value = .value
end with
end sub

ここでブックがない場合、そのブックを飛ばしてあるブックだけコピーしたい場合は、どうしたらいいでしょうか。いろいろやってみましたが、コピーできませんでした。
教えてください。

投稿日時 - 2012-11-08 10:27:48

QNo.7787414

困ってます

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

補足より
> 返ってきてない人だけを飛ばして処理をつづけたい
おそらく、このやり方だと「ひずみ」が生じます。

帰ってきていない人(Cさんとしましょう)の分を飛ばして、
他の人(A・B・D・Eさん)4人分のブックを取り込みました。
遅れて、Cさんがブックを用意したので、取り込みます。
この時に、すでに取り込んでいるAさんのブックがフォルダに残っていたら、
Aさんのブックを重複して取り込み、あとで削除しなきゃならない・・
と言う、いわゆる二度手間が発生しますので。


なので、私からの提案として
「ダイアログを開き、取り込むファイルを指定する(複数可)」
と言う手段を挙げておきます。

Sub test()
Dim FBook As Variant, TBook As Variant
Dim NWB As Workbook, OWB As Workbook
Dim SCnt As Integer
  
  'ダイアログを開いたときに表示したいフォルダを指定
  ChDir ("C:\Users\owner\Documents")
   
  'ファイルを選択するダイアログを表示
  FBook = Application.GetOpenFilename( _
      FileFilter:="エクセルファイル(*.xls*),*.xls*", _
      FilterIndex:=1, _
      Title:="ファイル選択", _
      MultiSelect:=True)

  'ファイルが選択されたら以下の処理、キャンセルされたらメッセージ
  If IsArray(FBook) Then
    'NWBにコピー先のブックを格納
    Set NWB = ActiveWorkbook

    'FBookに格納されたブックを順に取り出す
    For Each TBook In FBook
      '格納されたブックを一つ取り出して、OWBに格納
      Workbooks.Open TBook
      Set OWB = ActiveWorkbook
      
      'コピー先のシート数をカウント
      SCnt = NWB.Worksheets.Count
      
      'OWB(コピー元)の1つ目のシートをNWM(コピー先)の末尾にコピー
      'OWB.Worksheets(1).Copyの数字を変えると○番目のシートに変更可能
      OWB.Worksheets(1).Copy After:=NWB.Worksheets(SCnt)

      'OWBを閉じる
      OWB.Close
    Next TBook    'FBookが無くなるまで繰り返し
  Else
    MsgBox "キャンセルされました"
  End If

End Sub


これを「コピー先」のプロシージャに貼り付けて、実行してみてください。
ダイアログでCtrl+クリックで複数選択、開くボタンで処理を開始します。

2003で作成、2010で動作確認しましたので、おそらくどのバージョンでも動くと思います。
とりあえず、お試しください。

投稿日時 - 2012-11-08 23:57:38

お礼

こんにちは。
お礼が遅くなり、大変申し訳ありません。
コピーして動作確認をしました。
こんな方法もあるんですね。もっと勉強しなければ・・・。
シートごとではなく、シートの値だけコピーできるようにいろいろやってみます。
回答ありがとうございました。

投稿日時 - 2012-11-12 11:40:33

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

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

回答(3)

ANo.2

先の回答者様と同内容になりますが・・・
補足を読みましたが、イマイチ状況が分かりづらいです

set mybook=workbook.open(thisworkbook.path&"¥コピー元ブック.xls")
↑ここで エラーになりますか?
 これが、各担当者からもらうブックを保存しているパスですか?

このコードからみて、5名分のブック(あるいはシート)を繰り返し処理しているようには
見えません。

操作は
(1)一つのブックを開いて、マクロ実行する
(2)別のブックを開いて、マクロ実行する

との繰り返しでしょうか?

mybookを変数で宣言し、setされてますが
その後mybookを使ってないようですが・・・

質問返しになってスミマセン

投稿日時 - 2012-11-08 21:51:46

補足

おはようございます。
ほんとに分かりにくい説明でスミマセン。
mybookでコピー元をsetし、これが5回続きます。

Set myBook = Workbooks.Open(ThisWorkbook.Path & "¥Aさん個人ブック.xls")
With Workbooks("Aさん個人ブック.xls").Worksheets("sheet1").UsedRange
Workbooks("集計ブック.xls").Worksheets("Aさん").Range("A1:L76").Value = .Value
myBook.Close False
End With

Set myBook = Workbooks.Open(ThisWorkbook.Path & "¥Bさん個人ブック.xls")
With Workbooks("Bさん個人ブック.xls").Worksheets("sheet1").UsedRange
Workbooks("集計ブック.xls").Worksheets("Bさん").Range("A1:L76").Value = .Value
myBook.Close False
End With

以下続く。
ここでAさんのブックがないときに、Aさんの処理をとばしてBさんの処理からはじまるようにできないかと思いまして・・・。

投稿日時 - 2012-11-09 09:01:14

ANo.1

> ここでブックがない場合、そのブックを飛ばしてあるブックだけコピーしたい場合

とのことですが、すいませんが、補足をくださいませ。


・特定のフォルダ内の、「全てのブック」をコピー元とする?
            or
・特定のフォルダ内の、「特定の一つのブック」だけをコピー元とする?
            or
・特定のフォルダ内の、「特定の複数のブック」をコピー元とする?

コードを拝見する限り、「ブック名を固定」しているようですので、
> そのブックを飛ばしてあるブックだけ・・
の意図が不明瞭ですので。


また、
・コピー元ブックの、「全てのシート」をコピーする?
            or
・コピー元ブックの、「特定の一つのシート」をコピーする?
 (全てのブックで「シート名は固定されている?」)
            or
・コピー元ブックの、「特定の複数のシート」をコピーする?
 (全てのブックで「シート名は固定されている?」)

これもコードを拝見する限り「シート名を固定」しているようです。
上の質問で「ブックは複数」である場合、「同じシート名」があると
上手くコピーできない原因になりかねませんので。


以上がわかると、皆さんから回答を得やすいのではないかと思いますよ。

投稿日時 - 2012-11-08 11:44:53

補足

こんにちは。
説明たらずでスミマセン。
5人くらいにおのおのブックを作り(同じもの)AさんにはブックA、BさんにはブックBを渡し、このブックには月ごとのシートがあり、それに入力してもらい送り返してもらいます。そしてそれを元のブックにコピーするという形です。元ブックには、各自の1月なら1月のシートをコピーするという形にしたいのです。全員のブックが返ってきている時点でボタンを押せば問題ないのですが、一人返ってきてないとあたりまえですが、このブックがありませんとエラーがでます。ここで返ってきてない人だけを飛ばして処理をつづけたいのです。分かりにくい説明でスミマセン。

投稿日時 - 2012-11-08 13:16:13

あなたにオススメの質問