• ベストアンサー

EXCEL VBA シートをコピーする時にエラーが発生してしまう件

EXCEL VBAでシートをコピーするマクロを作成しているのですが、【10】にて時々エラーが発生してしまいます。100シート分ぐらいをコピーしたいのですが、途中で30シートぐらいの所で止まってしまいます。 (シートが10前後だと問題なく処理が終ります) 止まってしまうシートはまちまちなので、 シート名称が問題だとは考えにくいです。 ちなみに【8】でのsheets_nameは取得できてます。 前後に何かを入れることにより解決するのか、 ソース本体をいじれば解決するのか、 詳しい方、何卒、解決方法を ご指導いただけますよう宜しくお願いします。 【1】 '取得した配列の数だけループを行う。 【2】 For i = LBound(test) To 配列数 - 1 【3】 【4】 列番号 = Mid(test(i), 4, 3) 【5】 Debug.Print "test(" & i; ") : " & test(i) 【6】 【7】 'FORMATシートをコピーし、その名称を変数名にする 【8】 sheets_name = Worksheets("実績").Cells(18, 列番号).Value 【9】 【10】 Worksheets("FORMAT").Copy After:=Sheets("FORMAT") 【11】 【12】 ActiveSheet.Name = (sheets_name) 【13】 Cells(4, 3) = (sheets_name)

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

  • ベストアンサー
  • imogasi
  • ベストアンサー率27% (4737/17068)
回答No.3

コードとしては下記と等価だと思います。 空のシートでやってみると、スムーズにうまく行きました。 下記のシートSheet1のデータ・関数式他メモリの使用状況によるのではないでしょうか。 コピーの終了を見届けて、次のループに入ればよいのかもしれませんが、可能か、どうすればよいか方法が私にはわかりません。 Sub test02() For i = 1 To 100 sheets_name = i Worksheets("Sheet1").Copy After:=Sheets("sheet1") ActiveSheet.Name = sheets_name Next i End Sub エクセル2002でXP標準メモリ容量程度です。

その他の回答 (3)

  • Wendy02
  • ベストアンサー率57% (3570/6232)
回答No.4

こんばんは。 シートコピーは、無限にできるわけでもないので、 >途中で30シートぐらいの所で止まってしまいます。 このぐらいが、常識的な限度だと私は思います。ワークシートの内容量にもよりますが、この常識的な量は超えないほうが安全だと思います。実験的には、何百シートができるだとしても、私は、量が増える可能性がある場合は、ブックで分散して、それを参照設定でつないでいます。

  • hana-hana3
  • ベストアンサー率31% (4940/15541)
回答No.2
valleyvalley
質問者

お礼

この質問は非常に参考になりました。 http://oshiete1.goo.ne.jp/kotaeru.php3?q=1685998 このサイトでの事前の調べが足りなかったです(反省) ありがとうございました。 解決に繋がりそうです。

  • KenKen_SP
  • ベストアンサー率62% (785/1258)
回答No.1

こんにちは。KenKen_SP です。 自信なしですが、、、 「たまにうまくいかない」ということですね? 連続コピーで Excel がビジーになり、処理が追いつかないのではないか と推測します。適度にウェイトしてみてはどうでしょうか? 標準モジュールの先頭に以下の API 関数を貼り付けます。 Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) それから、ご提示のコードを次を追加します。 Worksheets("FORMAT").Copy After:=Sheets("FORMAT") Sleep 500 '<-- 追加:500ミリ秒のウェイト(任意) DoEvents '<-- 追加:制御を一瞬 OS に渡します

valleyvalley
質問者

お礼

KenKen_SPさん、 ありがとうございました。 早速、試してみます。 ウェイトをどうさせたらいいのかな~? と思っていたのでズバリでした。 本当にありがとうございました。

関連するQ&A

  • Excel VBAシートの同一番地のセルのリスト化

    別々のシートの同一番地のセルの値をリスト化するのにこのようなVBAを見つけました。 シートは追加せず、既存のシートを指定したくて、色々と書き換えをチャレンジしましたがうまくいきません。 既存のシートを指定し、この作業を行うにはどうしたらよいのでしょうか? ご教示いただけますと幸甚です。 Sub Test1() Dim TmpSheet As Worksheet, i As Integer i = Worksheets.Count Set TmpSheet = Worksheets.Add(After:=Sheets(Sheets.Count)) With TmpSheet For i = 1 To i .Cells(i, 1).Value = Worksheets(i).Name .Cells(i, 2).Value = Worksheets(i).Range("E5").Value Next End With End Sub

  • Excel VBA セルの値をシート名にしたいのです。

    こんばんは 新しくシートを挿入させて、「シート2」の値のみをコピーさせたいと考えています。 その新しく挿入させたシート名を「シート1」のせるA3とA4の文字列をあわせたものにしたいのですが、どうしたらよいのでしょうか。 途中まで考えたところでいきずまってしまいました。 どうか英知をお貸しください。 宜しくお願い致します。 A3には日付、A4には名前が入力されています。 Dim sheetName As String Worksheets("月度集計").Activate Sheets.Add After:=Sheets(Sheets.Count) ActiveSheet.Name = Worksheets("Sheet1").Cells(3, 3).Value On Error Resume Next Worksheets(1).Name = sheetName On Error GoTo 0 Range("f2").Select

  • Excel VBA グラフ作成のときのエラー

    VBA初心者です。Excel2003を使っています。 Sheet1に作りたいグラフがあります。 データは下記のとおりです。 ActiveChart.SeriesCollection(1).Name = Cells(a_data, "A")のところで、「実行時エラー13 型が一致しません」とエラーがでます。 不思議なのは、昨日は動いていたのです。 なぜ、エラーが出るようになったのかわかりません。 ご教授よろしくお願いします。 A B 1 a 1 2 2 3 3 4 4 5 5 6 b 6 7 7 8 8 9 9 10 10 11 c 11 12 12 13 13 14 14 15 15 Sub test() Wrow = Worksheets("sheet1").Cells(Rows.Count, "A").End(xlUp).Row For i = 1 To Wrow If Worksheets("sheet1").Cells(i, "A").Value = "a" Then a_data = Worksheets("sheet1").Cells(i, "A").Row ElseIf Worksheets("sheet1").Cells(i, "A").Value = "b" Then b_data = Worksheets("sheet1").Cells(i, "A").Row ElseIf Worksheets("sheet1").Cells(i, "A").Value = "c" Then c_data = Worksheets("sheet1").Cells(i, "A").Row ElseIf Worksheets("sheet1").Cells(i, "A").Value = "d" Then d_data = Worksheets("sheet1").Cells(i, "A").Row End If Next Sheets("sheet1").Select Range(Cells(a_data, "B"), Cells(b_data, "B")).Select ActiveSheet.ChartObjects.Add(30, 10, 500, 200).Select ActiveChart.ChartType = xlLineMarkers ActiveChart.SetSourceData Source:=Sheets("sheet1").Range(Cells(a_data, "B"), Cells(b_data - 1, "B")), PlotBy:=xlColumns ActiveChart.Location where:=xlLocationAsObject, Name:="sheet1" Sheets("sheet1").Select ActiveChart.Axes(xlCategory, xlPrimary).CategoryType = xlAutomatic ActiveChart.SeriesCollection.NewSeries ActiveChart.SeriesCollection.NewSeries ActiveChart.SeriesCollection.NewSeries ActiveChart.SeriesCollection(1).Name = Cells(a_data, "A") ←エラーがでます。 ActiveChart.SeriesCollection(2).Values = Range(Cells(b_data, "B"), Cells(c_data, "B")) ActiveChart.SeriesCollection(2).Name = Cells(b_data, "A") ActiveChart.SeriesCollection(3).Values = Range(Cells(c_data, "B"), Cells(d_data, "B")) ActiveChart.SeriesCollection(2).Name = Cells(c_data, "A") End Sub

  • ExcelのVBAの配列に関する質問です。

    ExcelのVBAの配列に関する質問です。 sheet1のデータをsheet2に表示するVBAを作成しています。。 sheet1のデータは7行目からスタートし、sheet2のデータは26行目からスタートしています。。 sheet1とsheet2の列は同じ並びではないため、それぞれのシートの列番号をCellsを用いて指定しています。 Sub test1() Dim endrow As Long endrow = Worksheets("sheet1").Range("A65536").End(xlUp).Row Dim i As Long Dim j As Long For i = 7 To endrow j = i + 19 Worksheets("sheet2").Cells(j, 1) = Worksheets("sheet1").Cells(i, 2) Worksheets("sheet2").Cells(j, 8) = Worksheets("sheet1").Cells(i, 28) Worksheets("sheet2").Cells(j, 9) = Worksheets("sheet1").Cells(i, 31) Worksheets("sheet2").Cells(j, 10) = Worksheets("sheet1").Cells(i, 32) ・ ・ ・ ※長いので省略 Next i End Sub 上記のtest1は正常に動くのですが、データ量が多いため、処理に時間がかかってしまいます。 高速化できないかと、以下のように変更しました。 Sub test2() Dim dataRange1 As Variant Dim dataRange2 As Variant dataRange1 = Worksheets("sheet1").Range("A1:GI10006") dataRange2 = Worksheets("sheet2").Range("A1:DZ10018") Dim endrow As Long endrow = Worksheets("sheet1").Range("A65536").End(xlUp).Row Dim i As Long Dim j As Long For i = 7 To endrow j = i + 19 dataRange2(j, 1) = dataRange1(i, 2) dataRange2(j, 8) = dataRange1(i, 28) dataRange2(j, 9) = dataRange1(i, 31) dataRange2(j, 10) = dataRange1(i, 32) ・ ・ ・ ※長いので省略 Next i End Sub test2は、エラーメッセージ等は表示されませんが、sheet2にデータが表示されません。 ちなみに、以下のようにsheet1のみ配列化した場合は、正常に表示されました。 Worksheets("sheet2").Cells(j, 1) = dataRange1(i, 2) Worksheets("sheet2").Cells(j, 8) = dataRange1(i, 28) Worksheets("sheet2").Cells(j, 9) = dataRange1(i, 31) Worksheets("sheet2").Cells(j, 10) = dataRange1(i, 32) test2は、どこが間違っているのでしょうか? ご教示ください。 よろしくお願いいたします。

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

    マクロでシート1を最後尾に名前をつけてコピーしたいと思ってます。 つけたい名前は、シート2のあるセルにかいてあります。 私は下記のように書いたのですが、エラーになってしまいます。 Worksheets("Sheet2").Select newsheet = Cells(1, 1) Sheets("Sheet1").Select Sheets("Sheet1").Copy After:=Sheets(newsheet) どのようにすればシートをシート名をつけてコピーできますか? 教えてください。 エクセル97です。

  • VBA 任意のシートからコピーを始める。

    教えてください。 全てのシートをコピーして一つのシートにまとめるプログラムシートを作成しました。 1番目のシートからコピーを始める場合は For i = 2 To Worksheets.Count 2番目のシートからコピーを始める場合は For i = 3 To Worksheets.Count とすればよいのですがこれだといちいちモジュールコードを出して数字を変更しなければならず面倒です。 そこでユーザーフォームのコンボボックスに任意の数字を入れてクリックを押せば希望するシートからコピーを始めるプログラムを作成してみましたがうまくいきません。どなたか教えてくださいませんか。 Sub matome() Dim i As Integer Dim lRow As Long, lCol As Long, lRow2 As Long, lRow3 As Long, SNo As Integer '----何番目からコピーを始めるかを決定します With UserForm2 SNo = .ComboBox1.value End With For i = 1 + SNo To Worksheets.Count With Worksheets(i) lRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1 lCol = .Cells(1, Columns.Count).End(xlToLeft).Column '----シートのデータが2行以上の場合にコピーします If lRow >= 2 Then lRow2 = Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row + 1 If lRow2 < Worksheets(1).Cells(Rows.Count, 5).End(xlUp).Row + 1 Then lRow2 = Worksheets(1).Cells(Rows.Count, 5).End(xlUp).Row + 1 .Activate .Range(Cells(2, 1), Cells(lRow, lCol)).Copy Worksheets(1).Cells(lRow2, 1) End If End With Next i

  • Execel VBA でシートの作成後、コピペがうまくいかない。

    シートのコピー&ペーストがしたくて、以下のPGを 組みましたが、うまくいきません。 (1)(2)と二通り試してみましたが、両方だめでした。 どなたか、おわかりになるかた、教えてください。 for i = 1 To page_cnt (1)Sheets.Add ActiveSheet.Name = "請求書(控)" & i Sheets("請求書" & i).Select sheet_name = "請求書(控)" & i Sheets(sheet_name).Cells("A1").Select Selection.Paste (2) Sheets.Add ActiveSheet.Name = "納品書(控)" & i Sheets("納品書" & i).Cells.Copy Sheets("納品書(控)" & i).Paste Next

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

    いつもお世話になっています、マクロ初心者です。 カレンダーの1月分をシートごと12月までコピーするのに、サンプル集をそのまま引用したのですが、シート名を指定する所でエラーになってしまいます。 $"月"の部分を削除すればうまくいきます。 エクセル2000パーソナルだからなのでしょうか? 'シートコピー Worksheets(1).Cells.Copy For i = 2 To 12 Worksheets.Add after:=Worksheets(ActiveSheet.Index) ActiveSheet.Name = CStr(i) & "月"(この行がエラーになります) ActiveSheet.Paste Range("A1").Select Next i エクセル2000パーソナルで処理する方法がありましたら教えてください。

  • EXCELでシート名を他のシートにあるリストから取得するには?

    sheet(1)には、名称のリスト(A(a)・B(b)・C(c)・・・)があり、sheet(2)には、アンケート用紙があります。 このsheet(2)をsheet(1)にある名称リストの分だけ、コピーし、コピーされたsheet(3)以降のシート名称をsheet(1)にある名称から順に取得して(コピーされたシート名称をA・B・C・・・と名付け)、さらに、 名付けられたシート上のある、一つのセルの値をsheet(1)のリスト(a・b・c・・・)を参照するものとしたいのですが、マクロをくめないでいます。 VAB初心者には難しいでしょうか。以下のように組んでみましたが・・・ Sub Macro1() Dim i As Long For i = 2 To 20 Sheet(2).Copy After:=Sheet(i) Range("F:L").Select ActiveCellR1C1 = "=Sheet(1)!R[i]C[-4]" Sheets(1).Range(Cells(i,"B").Value.Select Selection.Copy Sheets(i).Range("F1:L1").Paste Sheets(i).Name = Sheet(1).Cells(i, "A") Next i End Sub

  • VBAでコピー&ペーストをループ化する方法

    お忙しいところ申し訳ありません、ご教授の程お願い致します。 ワークシート(1)とワークシート(2)の間で特定のセル列をコピー&ペーストしたくそれを列のデータが無くなるまで(空白まで)処理したいのですが、 単一セルの処理は Worksheets("ワークシート(1)").Range("BJ2") = Worksheets("ワークシート(2)").Range("E2") で値の貼り付けが実行され成功したのですがそれをループ化したい構文に当てはめると空白まで自動的に処理してくれるような動作をしません。 検索してしらべてみたのですが、 Sub test() Dim i As Integer i = 1 Do Until cells(i, 2) = "" cells(i, 2) = Worksheets("ワークシート(1)").cells(2, 62) = Worksheets("ワークシート(2)").cells(2, 5).End(xlDown) i = i + 1 Loop End Sub で、試してみましたが動作しなかったです。 お忙しいところ申し訳ありませんが、宜しく御願い申し上げます。

専門家に質問してみよう