• ベストアンサー

シートを別のブックに複数自動コピー

初質問です。よろしくお願いします。 マクロを使って、あるブックのシート(20から50枚程度)を、別の貼り付け先のブックに自動的にコピーしようとすると、10回をすぎたあたり(必ずしも一定せず)で 「実行時エラー'1004': WorksheetクラスのCopyメソッドが失敗しました。」 というエラーと共にマクロが止まり、デバッグしようとすると 「ActiveSheet.Copy After:=Workbooks("貼り付け先ブック.xls").Sheets("○○シート")」 のところで止まっています。 マクロの記述内容は以下の通りです。 Sheets("貼り付け元シート").Activate ActiveSheet.Copy After:=Workbooks("貼り付け先ブック.xls").Sheets("○○シート") Cells.Select Selection.Copy Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Application.CutCopyMode = False Range("A1").Select Windows("貼り付け元ブック.xls").Activate ・・・以下貼り付け元シートを変えつつ複数回繰り返し これができる様になれば非常にラクになるので、ぜひご教授願います。

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

  • ベストアンサー
  • papayuka
  • ベストアンサー率45% (1388/3066)
回答No.4

#2です。 情報は小出しにしないで開示しましょう。 グラフがあるのなら話は大きく変わります。 単純なオートシェイプなら pWS.Cells.PasteSpecial Paste:=xlPasteAll を pWS.Paste にすると出来ますが、グラフとなるとデータリンク元の問題が出ます。 そうすると結局 toorukunさんの元マクロと同じ方法を使わざるを得なくなります。(使わずにやるとそれはそれで面倒) 元マクロのエラー原因は不明ですが、下記のマクロで100シート程コピーしてみましたがエラーにはなりませんでした。(Excel2000) Sub Test1() Dim pBook As Workbook Dim cWS As Worksheet, pWS As Worksheet Set pBook = Workbooks("貼り付け先ブック.xls") Set cWS = Workbooks("貼り付け元ブック.xls").Worksheets("Sheet1") For i = 1 To 5   'テストとしてセル A1 に 1~5を入れて作る    cWS.Range("A1").Value = i    cWS.Copy after:=pBook.Worksheets(pBook.Worksheets.Count)    Set pWS = ActiveSheet    pWS.Cells.Copy    pWS.Cells.PasteSpecial Paste:=xlValues    On Error Resume Next    pWS.Name = i    Application.CutCopyMode = False Next i End Sub

toorukun
質問者

お礼

早速の対応ありがとうございました。 シート数を20にして実行してみたところ、なぜか11回貼り付けたところで暴走し、貼り付け元シートが「自分自身」に12回目~20回目の貼り付けを行うという珍現象となりました・・・。もしかすると11回ぐらいで何かの上限に触れているのかもしれません。

すると、全ての回答が全文表示されます。

その他の回答 (7)

  • papayuka
  • ベストアンサー率45% (1388/3066)
回答No.8

#2です。 うーん、、、 こちらでは新規ブックにグラフを作り試しましたが問題なく動きます。 * 新規ブックなら50回でもOK * マクロだと最初のシート数 + 11枚しかシートをコピー追加出来ない * 手作業でシートコピーは何枚でも可能 ブックが変になっているのかなぁ、、、 シートの構成や使用セルのアドレス(A1:C10にあるデータでグラフを作っているとか)、コピー時に書き換えているデータ内容、セルアドレス等の細かい情報と実際のマクロを提示されて、こちらで再現出来れば良いのですが、文を読んで想像だけで書いてる現状ではこの辺が限界のようです。

toorukun
質問者

お礼

結局、貼り付けシートを2つにしても止まる、止まるのはペースト時ではなくコピー時、軽いグラフなら止まらない、等々の事象が分かってきました。ということは貼り付ける元のシートの重さに問題がありそうですのて、この筋でまた調べてみます。色々ありがとうございました。

すると、全ての回答が全文表示されます。
  • papayuka
  • ベストアンサー率45% (1388/3066)
回答No.7

#2です。 新規シートの追加は可能なようですが、シートのコピーだと上手く行かないような感じですね。 2つのブックを並べて、貼り付け元ブックの該当シートを Ctrlキーを押しながら貼り付け先ブックにドラック&ドロップするとシートがコピーされますよね? これの作業は手作業で20回出来るのでしょうか? 貼り付け元ブックの該当シートのオブジェクト名は Sheet1111111111111111111111111 のようになってませんよね?

toorukun
質問者

お礼

朝早くからすいません。手作業での貼り付けはできます。現状では、12枚からはそれで処理しているところです。また、「Sheet1111111111111111111111111」という現象は出ていません。

すると、全ての回答が全文表示されます。
  • papayuka
  • ベストアンサー率45% (1388/3066)
回答No.6

#2です。 解かりませんね。 もう一度聞きますが、サンプル通りで暴走しますか? 新規ブックを2つ立ち上げて、 Set pBook = Workbooks("Book1") Set cWS = Workbooks("Book2").Worksheets("Sheet1") のような環境で試しても同様でしょうか? サンプルだと A1セルに数字が入るので確認しやすいと思います。 > 貼り付け先ブックには12回以上はどうしても貼り付けられない 貼り付け先ブックのシートが1枚だとしたら、20回ループさせるとシートが21枚になるハズですが、13枚までしか出来ないという意味でしょうか?それとも21枚出来るけど、13枚以降はデータが同じシートになってしまうって意味でしょうか?13枚以降はデータが同じって事はないですよね?

toorukun
質問者

お礼

サンプル通りで貼り付け対象が白紙のシートの場合、50回でも問題なく動きます。それを実際に貼り付けたいグラフ混じりのシートにすると「11回」までしか貼り付きません。また、貼り付け先ブックに元々シートが1枚あっても3枚あっても、実際に貼り付けられる数は「11枚」になります。総計だと12枚か14枚になるわけです。また、その11枚目が9回「上書きで」貼り付けられています。ブックを分けるのは試してみます。

すると、全ての回答が全文表示されます。
  • papayuka
  • ベストアンサー率45% (1388/3066)
回答No.5

#2です。 サンプル通りでも暴走しますか? 原因は Set pWS = ActiveSheet だと思われます。 アクティブシートを見失う何かがあるのかな? Set pWS = ActiveSheet を Set pWS = pBook.Worksheets(pBook.Worksheets.Count) に変えるとどうでしょう?

toorukun
質問者

お礼

毎度すいません。 試したところ、「自分自身」を複写しなくなった代わりに、11回目に貼り付けたシートを12回目から20回目の9回分複写するという現象になりました。 貼り付け先ブックには12回以上はどうしても貼り付けられない、ということのようです。やはり何かの制限でしょうか?

すると、全ての回答が全文表示されます。
  • papayuka
  • ベストアンサー率45% (1388/3066)
回答No.3

#2です。 会員リストのようなものがあって、そこから個人別シートに VLookup 関数等でデータを引っぱってくるようになっており、値のみに置き換えた個人別シートを別ブックに作りたいって感じかな。 上記イメージでサンプルを直しました。 試すならテスト環境で。 Sub Test() Dim pBook As Workbook Dim cWS As Worksheet, pWS As Worksheet Set pBook = Workbooks("貼り付け先ブック.xls") Set cWS = Workbooks("貼り付け元ブック.xls").Worksheets("Sheet1") For i = 1 To 5   'テストとしてセル A1 に 1~5を入れて作る   cWS.Range("A1").Value = i   Set pWS = pBook.Worksheets.Add _     (after:=pBook.Worksheets(pBook.Worksheets.Count))   cWS.Cells.Copy   pWS.Cells.PasteSpecial Paste:=xlPasteAll   pWS.Cells.Copy   pWS.Cells.PasteSpecial Paste:=xlValues   On Error Resume Next   pWS.Name = i   Application.CutCopyMode = False Next i End Sub

toorukun
質問者

お礼

すごい!今ちょっとカスタマイズして使ってみたところ、途中で止まることもなくうまく走りました! でも、実は貼り付けたいシートにはグラフもついているのですが、グラフは貼り付けられませんでした・・・。 もしよろしかったら、グラフも一緒に貼り付けられる方法も教えて頂けるとありがたいのですが・・・。

すると、全ての回答が全文表示されます。
  • papayuka
  • ベストアンサー率45% (1388/3066)
回答No.2

Excelのバージョンは何でしょう? Excel97だと同一シートをコピーし続けた場合に、シートのオブジェクト名(CodeName)が「Sheet111111111・・・・」のようになってしまいコピー出来なくなるバグがあるのですが、、 こんな感じだとどうでしょう? (試すならテストブックで) 貼り付け元ブックの全シートを貼り付け先ブックに書式を残して値コピーします。 セル結合があっても大丈夫だと思います。 Sub Test() Dim cBook As Workbook, pBook As Workbook Dim cWS As Worksheet, pWS As Worksheet Set pBook = Workbooks("貼り付け先ブック.xls") Set cBook = Workbooks("貼り付け元ブック.xls") For Each cWS In cBook.Worksheets   Set pWS = pBook.Worksheets.Add _     (after:=pBook.Worksheets(pBook.Worksheets.Count))   cWS.Cells.Copy   pWS.Cells.PasteSpecial Paste:=xlPasteAll   pWS.Cells.Copy   pWS.Cells.PasteSpecial Paste:=xlValues   On Error Resume Next   pWS.Name = cWS.Name   Application.CutCopyMode = False Next cWS End Sub

toorukun
質問者

お礼

回答ありがとうございます。 まだ試させていただいてはいないのですが、実は「貼り付け元ブック」にはシートが一つしかなく、それが一回「貼り付け先ブック」にコピーされると「貼り付け元ブック」のシートが書き換わり、その書き換わったシートを「貼り付け元ブック」にまたコピーしに行く、という作りなので、全シートをいっぺんに貼り付けに行く作りだと合わなくなるかな、と・・・。 ちなみにバージョンは2000です。 せっかく教えていただいているのにすいません・・・。

すると、全ての回答が全文表示されます。
  • eipu
  • ベストアンサー率39% (25/64)
回答No.1

現象はともかくとして、 シートをコピーするだけなら、 Sheets("貼り付け元シート").Activate ActiveSheet.Copy After:=Workbooks("貼り付け先ブック.xls").Sheets("○○シート") Windows("貼り付け元ブック.xls").Activate の繰り返しで大丈夫だと思います。

toorukun
質問者

お礼

早速の回答ありがとうございます。 実は、貼り付け元のシートは一回貼り付ける度に内容が変わるようになっているので、リンクを切る作りにしました。ただ、マクロが若干重たいのも一因かなとは思うのですが・・・。

すると、全ての回答が全文表示されます。

関連するQ&A

専門家に質問してみよう