- ベストアンサー
シートを別のブックに複数自動コピー
初質問です。よろしくお願いします。 マクロを使って、あるブックのシート(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 ・・・以下貼り付け元シートを変えつつ複数回繰り返し これができる様になれば非常にラクになるので、ぜひご教授願います。
- みんなの回答 (8)
- 専門家の回答
質問者が選んだベストアンサー
#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
その他の回答 (7)
- papayuka
- ベストアンサー率45% (1388/3066)
#2です。 うーん、、、 こちらでは新規ブックにグラフを作り試しましたが問題なく動きます。 * 新規ブックなら50回でもOK * マクロだと最初のシート数 + 11枚しかシートをコピー追加出来ない * 手作業でシートコピーは何枚でも可能 ブックが変になっているのかなぁ、、、 シートの構成や使用セルのアドレス(A1:C10にあるデータでグラフを作っているとか)、コピー時に書き換えているデータ内容、セルアドレス等の細かい情報と実際のマクロを提示されて、こちらで再現出来れば良いのですが、文を読んで想像だけで書いてる現状ではこの辺が限界のようです。
お礼
結局、貼り付けシートを2つにしても止まる、止まるのはペースト時ではなくコピー時、軽いグラフなら止まらない、等々の事象が分かってきました。ということは貼り付ける元のシートの重さに問題がありそうですのて、この筋でまた調べてみます。色々ありがとうございました。
- papayuka
- ベストアンサー率45% (1388/3066)
#2です。 新規シートの追加は可能なようですが、シートのコピーだと上手く行かないような感じですね。 2つのブックを並べて、貼り付け元ブックの該当シートを Ctrlキーを押しながら貼り付け先ブックにドラック&ドロップするとシートがコピーされますよね? これの作業は手作業で20回出来るのでしょうか? 貼り付け元ブックの該当シートのオブジェクト名は Sheet1111111111111111111111111 のようになってませんよね?
お礼
朝早くからすいません。手作業での貼り付けはできます。現状では、12枚からはそれで処理しているところです。また、「Sheet1111111111111111111111111」という現象は出ていません。
- papayuka
- ベストアンサー率45% (1388/3066)
#2です。 解かりませんね。 もう一度聞きますが、サンプル通りで暴走しますか? 新規ブックを2つ立ち上げて、 Set pBook = Workbooks("Book1") Set cWS = Workbooks("Book2").Worksheets("Sheet1") のような環境で試しても同様でしょうか? サンプルだと A1セルに数字が入るので確認しやすいと思います。 > 貼り付け先ブックには12回以上はどうしても貼り付けられない 貼り付け先ブックのシートが1枚だとしたら、20回ループさせるとシートが21枚になるハズですが、13枚までしか出来ないという意味でしょうか?それとも21枚出来るけど、13枚以降はデータが同じシートになってしまうって意味でしょうか?13枚以降はデータが同じって事はないですよね?
お礼
サンプル通りで貼り付け対象が白紙のシートの場合、50回でも問題なく動きます。それを実際に貼り付けたいグラフ混じりのシートにすると「11回」までしか貼り付きません。また、貼り付け先ブックに元々シートが1枚あっても3枚あっても、実際に貼り付けられる数は「11枚」になります。総計だと12枚か14枚になるわけです。また、その11枚目が9回「上書きで」貼り付けられています。ブックを分けるのは試してみます。
- papayuka
- ベストアンサー率45% (1388/3066)
#2です。 サンプル通りでも暴走しますか? 原因は Set pWS = ActiveSheet だと思われます。 アクティブシートを見失う何かがあるのかな? Set pWS = ActiveSheet を Set pWS = pBook.Worksheets(pBook.Worksheets.Count) に変えるとどうでしょう?
お礼
毎度すいません。 試したところ、「自分自身」を複写しなくなった代わりに、11回目に貼り付けたシートを12回目から20回目の9回分複写するという現象になりました。 貼り付け先ブックには12回以上はどうしても貼り付けられない、ということのようです。やはり何かの制限でしょうか?
- papayuka
- ベストアンサー率45% (1388/3066)
#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
お礼
すごい!今ちょっとカスタマイズして使ってみたところ、途中で止まることもなくうまく走りました! でも、実は貼り付けたいシートにはグラフもついているのですが、グラフは貼り付けられませんでした・・・。 もしよろしかったら、グラフも一緒に貼り付けられる方法も教えて頂けるとありがたいのですが・・・。
- papayuka
- ベストアンサー率45% (1388/3066)
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
お礼
回答ありがとうございます。 まだ試させていただいてはいないのですが、実は「貼り付け元ブック」にはシートが一つしかなく、それが一回「貼り付け先ブック」にコピーされると「貼り付け元ブック」のシートが書き換わり、その書き換わったシートを「貼り付け元ブック」にまたコピーしに行く、という作りなので、全シートをいっぺんに貼り付けに行く作りだと合わなくなるかな、と・・・。 ちなみにバージョンは2000です。 せっかく教えていただいているのにすいません・・・。
- eipu
- ベストアンサー率39% (25/64)
現象はともかくとして、 シートをコピーするだけなら、 Sheets("貼り付け元シート").Activate ActiveSheet.Copy After:=Workbooks("貼り付け先ブック.xls").Sheets("○○シート") Windows("貼り付け元ブック.xls").Activate の繰り返しで大丈夫だと思います。
お礼
早速の回答ありがとうございます。 実は、貼り付け元のシートは一回貼り付ける度に内容が変わるようになっているので、リンクを切る作りにしました。ただ、マクロが若干重たいのも一因かなとは思うのですが・・・。
お礼
早速の対応ありがとうございました。 シート数を20にして実行してみたところ、なぜか11回貼り付けたところで暴走し、貼り付け元シートが「自分自身」に12回目~20回目の貼り付けを行うという珍現象となりました・・・。もしかすると11回ぐらいで何かの上限に触れているのかもしれません。