• ベストアンサー
  • 困ってます

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

共感・応援の気持ちを伝えよう!

  • 回答数3
  • 閲覧数332
  • ありがとう数1

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

  • ベストアンサー
  • 回答No.3

補足より > 返ってきてない人だけを飛ばして処理をつづけたい おそらく、このやり方だと「ひずみ」が生じます。 帰ってきていない人(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で動作確認しましたので、おそらくどのバージョンでも動くと思います。 とりあえず、お試しください。

共感・感謝の気持ちを伝えよう!

質問者からのお礼

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

その他の回答 (2)

  • 回答No.2
  • mi-tan
  • ベストアンサー率32% (26/79)

先の回答者様と同内容になりますが・・・ 補足を読みましたが、イマイチ状況が分かりづらいです set mybook=workbook.open(thisworkbook.path&"¥コピー元ブック.xls") ↑ここで エラーになりますか?  これが、各担当者からもらうブックを保存しているパスですか? このコードからみて、5名分のブック(あるいはシート)を繰り返し処理しているようには 見えません。 操作は (1)一つのブックを開いて、マクロ実行する (2)別のブックを開いて、マクロ実行する との繰り返しでしょうか? mybookを変数で宣言し、setされてますが その後mybookを使ってないようですが・・・ 質問返しになってスミマセン

共感・感謝の気持ちを伝えよう!

質問者からの補足

おはようございます。 ほんとに分かりにくい説明でスミマセン。 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さんの処理からはじまるようにできないかと思いまして・・・。

  • 回答No.1

> ここでブックがない場合、そのブックを飛ばしてあるブックだけコピーしたい場合 とのことですが、すいませんが、補足をくださいませ。 ・特定のフォルダ内の、「全てのブック」をコピー元とする?             or ・特定のフォルダ内の、「特定の一つのブック」だけをコピー元とする?             or ・特定のフォルダ内の、「特定の複数のブック」をコピー元とする? コードを拝見する限り、「ブック名を固定」しているようですので、 > そのブックを飛ばしてあるブックだけ・・ の意図が不明瞭ですので。 また、 ・コピー元ブックの、「全てのシート」をコピーする?             or ・コピー元ブックの、「特定の一つのシート」をコピーする?  (全てのブックで「シート名は固定されている?」)             or ・コピー元ブックの、「特定の複数のシート」をコピーする?  (全てのブックで「シート名は固定されている?」) これもコードを拝見する限り「シート名を固定」しているようです。 上の質問で「ブックは複数」である場合、「同じシート名」があると 上手くコピーできない原因になりかねませんので。 以上がわかると、皆さんから回答を得やすいのではないかと思いますよ。

共感・感謝の気持ちを伝えよう!

質問者からの補足

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

関連するQ&A

  • エクセルのシートのコピーについて

    シートのコピーをVBAで行いたいのですが、エラーになってしまいます。 間違っている箇所が分からないのでご教授お願いします。 貼り付けというブックにマクロが組まれています。 ”データ”のブックにあるシート名が”貼り付けのブックのリスト”のシートに記載されています。 リストのシートに記載されているシートを貼り付けのブックにコピーしたいです。 よろしくお願いします。 Sub シートコピー() 行数 = 2 Do Until IsEmpty(Cells(行数, 3).Value) コピー元 = Workbooks("貼り付け.xls").Worksheet("リスト").Cells(行数, 3) Workbooks("データ.xls").Worksheet(コピー元).Copy After:=Workbooks("貼り付け.xls").Sheets(Workbooks("貼り付け.xls").Sheets.Count) 行数 = 行数 + 1 Loop End Sub

  • Excelマクロ(VBA)のブックとシートのコピーについて

    初めまして、宜しければVBAのブックやシートのコピー(操作)についてご教授お願いいたします。 Windows XP x64 OFFICE2003 を使用しております。 D:\Book1.elxのsheet1のシートをD:\test\Book2.elxのsheet1のシートに コピーする方法が恥ずかしながら理解できておりません。 以下が行いたい事です。 Sub ボタン1_Click() 'text1ブックを開く 'Workbooks.Open "D:\micro\test1.xls" 'ブック間のシートをコピー Workbooks("test2.xls").Worksheets("シート2").Copy _ After:=Workbooks("test1.xls").Worksheets("Sheet2") End Sub VBのファイル操作とは違い、どのように行えば良いのか検索しても同じような部分サンプルのようなものしか無く、理解できておりません。 参考でも結構ですのでご教授いただけませんでしょうか? よろしくお願いいたします。

  • エクセル 特定のシートを異なるブックの指定したシートにコピーするマクロ

    エクセルの"貼り付け先.xls"の(シート名="集計")を開いている状態で、 別の異なるブックの"貼り付け元.xls"の(シート名="sheet1")の内容を全部コピーして "貼り付け先.xls"の(シート名="集計元データ")へ貼り付けるマクロは どのようになりますでしょうか? いろいろ調べて下記のように書きましたが、 インデックスが有効範囲にありませんというメッセージが出て、 デバッグを確認すると Workbooks("貼り付け元.xls").Worksheets("Sheet1").Range("A1").Copy_の部分が黄色く表示されてきます。 (1) "貼り付け先.xls"と"貼り付け元.xls"は同じパソコンのマイドキュメントに保存されています。 (2)"貼り付け元.xls"の"Sheet1"はセルA1から入力されていて、 内容は毎日変わります。 (3)Range("A1")や("A1:IV65536")のセル番地をいろいろ変えたりしても同じでした。 Sub クリップボードを経由せずにコピー貼り付けする_異なるブック() Workbooks("貼り付け元.xls").Worksheets("Sheet1").Range("A1").Copy_ Workbooks("貼り付け先.xls").Worksheets("集計元データ.xls").Range ("A1:IV65536") End Sub

  • エクセルのマクロでシートのコピー

    いつもお世話になっております。 エクセル2000で次のことをマクロで行いたいのです。 いくつかWorkbookが開いている状態で、シートのコピーを行うのですが、シート名やブック名はその都度違います。 具体的には、Workbook"A" に "a"、"b"、"c" の3つのシート、Workbook"B" に "f"、"g"、"h"の3つのシートがあり、 Workbook"A" の Sheet("a") を Workbook"B" の Sheet("h") の前にコピーしたいのです。 Sheets(1).Copy before:=Workbooks("B.xls").Sheets(3) ところがWorkbookの名前がその都度変わるので困っています。 ブック間の移動は ActiveWindow.ActivateNext などで行っていますがシートのコピーがどうしても分からないので お願いします。  

  • 「 VBA の 宣言 」 がない場合の問題点は ?

    下記例で、 「 宣言 」 なしでも、現在のところ、問題は発生してませんが、 今後、「 宣言 」 がなかった場合の 「 問題点の例 」 を教えて下さいませ。 ------------------------------- Sub ブックA*の全シートをコピー() Dim Wb As Workbook '宣言 For Each Wb In Workbooks If Wb.Name Like "ブックA*.xls" Then With Workbooks("ブックB.xls") Wb.Worksheets _ .Copy after:=.Sheets(.Sheets.Count) End With End If Next Worksheets(Worksheets.Count).Activate MsgBox ActiveSheet.Index Worksheets("Sheet1").Select End Sub

  • ブック内に特定名のシートがある場合

    はじめまして、こんにちは。 VBAを最近はじめたばかりの者です。質問が初歩的なもので申し訳ないのですが是非教えてください。 以下を使って、複数ブックの○○というシートから指定セルの内容を抜き出したいと思っています。 ところが、ブックによっては○○というシートが存在しない場合があり、その場合には「インデックスが有効でない」というエラーで動作が止まってしまいます。 ブック内に○○というシートがある場合にのみ動作させるようにするにはどのようにすれば良いのでしょうか。 よろしくお願いします。 Dim wb As Workbook, myRow As Long Dim e As Integer myRow = ThisWorkbook.Worksheets(1).Rows.Count With Application.FileSearch .NewSearch .LookIn = ThisWorkbook.Path .SearchSubFolders = True .FileType = msoFileTypeExcelWorkbooks If .Execute() > 0 Then For i = 1 To .FoundFiles.Count If .FoundFiles(i) <> ThisWorkbook.FullName Then Set wb = Workbooks.Open(.FoundFiles(i), UpdateLinks:=0) Application.ScreenUpdating = False ThisWorkbook.Worksheets(1).Range("A" & myRow).End(xlUp).Offset(1, 0).Value = _ wb.Worksheets("○○").Range("F6").Value ThisWorkbook.Worksheets(1).Range("B" & myRow).End(xlUp).Offset(1, 0).Value = _ wb.Worksheets("○○").Range("F7").Value ThisWorkbook.Worksheets(1).Range("C" & myRow).End(xlUp).Offset(1, 0).Value = _ wb.Worksheets("○○").Range("F8").Value ThisWorkbook.Worksheets(1).Range("D" & myRow).End(xlUp).Offset(1, 0).Value = _ wb.Worksheets("○○").Range("Y6").Value wb.Close False End If Next i Else MsgBox "ファイルがありません。" End If End With End Sub

  • excelvbaにてシート名を指定してコピーしたい

    いつもお世話になっております。 excel vbaにて、複数シートをひとつのbookにまとめようとしております。 シート名を指定してコピーしたいのですが、すべてのシートがコピーされてしまい困っています。 Worksheets("日帰り")だけを指定するには、どこの記述を変更したらいいでしょうか? どなたか教えてください。 ----------------------------------------------------------------- Sub C_SheetCopy() On Error GoTo ErrorHandler Dim strPath As String Dim strBookName As String Dim TargetBook As Workbook Dim TargetSheet As Worksheet Dim OriginalSheet As Worksheet '指定した場所にあるxlsファイルについて処理 strPath = ThisWorkbook.Path '自分自身と同じ場所とする strBookName = Dir(strPath & "\*.xls") 'ファイル名取得 '対象ファイルが存在する限り処理 Do While strBookName <> "" If ThisWorkbook.Name <> strBookName Then '自分自身じゃないならそのブックを開く Set TargetBook = Workbooks.Open(strPath & "\" & strBookName) '開いたブックの全てのシートを処理 Set TargetSheet = TargetBook.Worksheets("日帰り") For Each TargetSheet In TargetBook.Worksheets '開いたブックのシートを自身の最後にコピー TargetSheet.Copy After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count) 'コピーしたシートの名前をコピー元ブック名&シート名に変更 ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count).Name = TargetBook.Name & TargetSheet.Name Next '開いたブックを閉じる TargetBook.Close Set TargetBook = Nothing End If strBookName = Dir '次のファイル Loop ErrorHandler: 'エラーが起きたら If Not (TargetBook Is Nothing) Then TargetBook.Close End If If Err Then MsgBox Err.Number & ":" & Err.Description, vbExclamation Err.Clear End If End Sub

  • 他ブックから指定範囲をコピー

    自分で調べたのですがよく分からないので質問します。 下のように書いたのですが 実行時エラー '424'; オブジェクトがッ必要です。というエラーが出ます。 Private Sub CommandButton3_Click() Dim F_Name As String, myRange As Range F_Name = Application.GetOpenFilename("Microsoft Excelブック,*.xls") If F_Name <> "False" Then Workbooks.Open F_Name With ActiveWorkbook Set myRange = .Worksheets(1).Range("B6:U509") .Saved = True .Close End With With ThisWorkbook myRange.Copy.Worksheets(2).Range ("B6:U509") End With End If Set myRange = Nothing End Sub やりたいことは読み込んだExcelのシート1(または金額というシート)のB6:U509範囲をコピーし 実行したブックのシート2(または金額というシート)のB6:U509範囲に貼り付けたいのです。 よろしくお願いします

  • EXCELのVBAを使用してフォルダー内の複数のデーターの集計処理を

    EXCELのVBAを使用してフォルダー内の複数のデーターの集計処理を 行いたいのですが1個目のデーター処理を行った後集計処理を行った後 集計シートを2個目のデーターに移動させたいのですが方法がわかりません。 下記のように集計表(原紙)を複数のデーターにコーピーはできるのですが Private Sub CommandButton1_Click() '集計表作成 Dim MyPath, MyBook, MyName MyPath = ThisWorkbook.Path & "¥" MyBook = ThisWorkbook.Name MyName = Dir(MyPath & "*.xls") Do While MyName <> "" If MyName <> MyBook Then Workbooks.Open Filename:=MyPath & MyName '一番左に集計表を貼り付ける Workbooks(MyBook).Worksheets(1).Copy Before:=Workbooks(MyName).Sheets(1) '"ここで集計処理後 次のBookへ移動" Workbooks(MyName).Save Workbooks(MyName).Close End If MyName = Dir Loop End Sub Copy部分をMoveにするとエラーメッセージがでてしまい 集計したシートを次々と移動させる方法がわかりません。 どのような方法で実行すれば宜しいでしょうか?

  • 複数のファイルのsheet1だけをまとめるには

    sub UsedRangeをOffsetする() Dim rng先 As Range Dim PathMacrobook As String Dim Name元book As String Dim 元Book As Workbook Dim 元Sheet As Worksheet Set rng先 = Workbooks("BOOKALL.xls").Worksheets(1).Range("A2") PathMacrobook = ThisWorkbook.Path & "\" Name元book = Dir(PathMacrobook & "*.xls") Do While Not Name元book = "" If Name元book = ThisWorkbook.Name Then ElseIf Name元book = "BOOKALL.xls" Then Else Set 元Book = Workbooks.Open(PathMacrobook & Name元book) For Each 元Sheet In 元Book.Worksheets With 元Sheet.UsedRange .Offset(1).Copy rng先 Set rng先 = rng先.Offset(.Rows.Count - 1, 0) End With Next 元Book.Close False End If Name元book = Dir() Loop End Sub このコードではフォルダにあるブックのすべてのシートをBOOKALLのシート1に 上書きコピーしてしまう事がわかりました。 やりたい事 オープンするブックのsheet1だけを、.end(xlup)を使って一覧にしたいです。。 どの様にしたらよいでしょうか?