• 締切済み

ExcelVBA 実行時エラー

お疲れ様です。 下記のExcelVBAでのプログラムなのですが、 なぜかいつもSelection.PasteSpecial Paste:=xlValuesの部分にデバック表示が出てしまいます。分かる方、少しのヒントでも良いので連絡ください。ちなみにプログラムは1997年にかかれたものです。 本当に困っています。宜しくお願い致します~。 ~~~~~~~~~~~~~~~~~~~~~~~~ Dim Bu, D_in, D_Copy As String D_Copy = ActiveSheet.Name 'マクロ実行Sheet(データ入力Sheetをコピー) Bu = Mid(D_Copy, 3, 3) '部コードを抽出 D_in = ("D-" & Bu) 'データ入力Sheet Msg = "前月データを複写してもよろしいですか?" Msg_ret = MsgBox(Msg, vbYesNo) If Msg_ret = vbNo Then End Else End If 'マクロ実行Sheetのデータをクリアする Range("Clear").Select Selection.ClearContents '上代売上単月データを一覧表にコピー Sheets(D_in).Select Select Case Month(Date) Case 4 Range("JT1,JT2").Copy Case 5 Range("JT3,JT4").Copy Case 6 Range("JT5,JT6").Copy Case 7 Range("JT7,JT8").Copy Case 8 Range("JT9,JT10").Copy Case 9 Range("JT11,JT12").Copy End Select Sheets(D_Copy).Select Range("B6").Select Selection.PasteSpecial Paste:=xlValues '在庫単月データを一覧表にコピー Sheets(D_in).Select Select Case Month(Date) Case 4 Range("Za1,Za2").Copy Case 5 Range("Za3,Za4").Copy Case 6 Range("Za5,Za6").Copy Case 7 Range("Za7,Za8").Copy Case 8 Range("Za9,Za10").Copy Case 9 Range("Za11,Za12").Copy End Select Sheets(D_Copy).Select Range("AD6").Select Selection.PasteSpecial Paste:=xlValues '上代売上累計データを一覧表にコピー ' 9月と3月はマクロの実行なし Sheets(D_in).Select Select Case Month(Date) Case 4 Sheets(D_Copy).Select Range("A6").Select End Case 5 Range("Ru1,Ru2").Copy Case 6 Range("Ru3,Ru4").Copy Case 7 Range("Ru5,Ru6").Copy Case 8 Range("Ru7,Ru8").Copy Case 9 Range("Ru9,Ru10").Copy End Select Sheets(D_Copy).Select Range("B52").Select Selection.PasteSpecial Paste:=xlValues End End Sub

みんなの回答

  • suz83238
  • ベストアンサー率30% (197/656)
回答No.1

実行して Selection.PasteSpecial Paste:=xlValues でエラーになるのは、ペーストするのにコピーしてないからです。 コピーは Select Case Month(Date) からしますが、4月~9月それぞれの範囲をコピーするようなってますので、今は2月なのでここはとばされてしまいます。 一番問題なのは、 Range("JT1,JT2").Copy でJT1とかないので、たとえ4月~9月でもここでエラーになります。 "JT1,JT2"をそれぞれのセルの範囲を指定し直せば、動くと思います。

hahaharuki
質問者

補足

早速のご回答ありがとうございます。返信が遅くなり申し訳ございませんでした。 セルの範囲ですが、10個ぐらいEXCELの表が一つのシートに幾つかあり、それぞれの表からその月の数値を持ってくるように作りたいと思っています。 その場合、EXCELのセルの範囲はどのようにすれば宜しいのでしょうか?また、このようなときに使えるプログラムはございますでしょうか?もしご存知でしたら教えてください。 VBA超初心者で申し訳ございませんが、何卒宜しくお願い致します。

関連するQ&A

  • マクロについて教えてください

    マクロの超初心者です。 数式を入力しているのではなく、配付物をエクセルで作成しているのですが、同じもの(氏名や項目は違いますが)を100枚ほど作成しているのでマクロを・・・と思ったのですがやり方が全く分かりません。 sheet1からsheet2に下記のようにデータを写したいのですが、やり方を教えてください。 ●氏名が入力されています sheet1(A9) → sheet2(C2) sheet1(E9) → sheet2(C5) sheet1(I9) → sheet2(C8) ●項目1 sheet1(A8) → sheet2(E3) sheet1(E8) → sheet2(E6) sheet1(I8) → sheet2(E9) ●項目2 sheet1(A18~D18の結合セル) → sheet2(E2) sheet1(E18~H18の結合セル) → sheet2(E5) sheet1(I18~L18の結合セル) → sheet2(E8) と反映させたいのですが、250行あるのですが、 簡単にマクロで出来ないでしょうか?? ちなみに↓コレが上記の内容で作ってみたものです。 わかりずらい質問でスイマセン。 Range("A9").Select Selection.Copy Sheets("sheet2").Select Range("C2").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Sheets("sheet1").Select Range("E9").Select Application.CutCopyMode = False Selection.Copy Sheets("sheet2").Select Range("C5").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Sheets("sheet1").Select Range("I9").Select Application.CutCopyMode = False Selection.Copy Sheets("sheet2").Select Range("C8").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Sheets("sheet1").Select Range("A8").Select Application.CutCopyMode = False Selection.Copy Sheets("sheet2").Select Range("E3").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Sheets("sheet1").Select Range("E8").Select Application.CutCopyMode = False Selection.Copy Sheets("sheet2").Select Range("E6").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Sheets("sheet1").Select Range("I8").Select Application.CutCopyMode = False Selection.Copy Sheets("sheet2").Select Range("E9").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Sheets("sheet1").Select Range("A18:D18").Select Application.CutCopyMode = False Selection.Copy Sheets("sheet2").Select Range("E2").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Sheets("sheet1").Select Range("E18:H18").Select Application.CutCopyMode = False Selection.Copy Sheets("sheet2").Select Range("E5").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Sheets("sheet1").Select Range("I18:L18").Select Application.CutCopyMode = False Selection.Copy Sheets("sheet2").Select Range("E8").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False End Sub

  • マクロ教えてください(繰り返しの方法)

    マクロ、VBAは超初心者です。 Sheets("optimizer").Select Range("C7").Select Selection.Copy Range("E6").Select ActiveSheet.Paste SolverOk SetCell:="$F$34", MaxMinVal:=1, ValueOf:="0", ByChange:="$F$28:$O$28" SolverSolve Userfinish:=True Range("F28:Q28").Select Selection.Copy Sheets("table").Select Range("D7").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Sheets("optimizer").Select Range("C8").Select Selection.Copy Range("E6").Select ActiveSheet.Paste SolverOk SetCell:="$F$34", MaxMinVal:=1, ValueOf:="0", ByChange:="$F$28:$O$28" SolverSolve Userfinish:=True Range("F28:Q28").Select Selection.Copy Sheets("table").Select Range("D8").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False 上のように同じことを何回も繰り返すのですが、2行目の Range("C8").SelectがC9, C10, C11・・・・、また下から3行目の Range("D8").SelectがD9, D10, D11・・・と貼り付けていくところだけを変えていきたいのです。 今は長いプロシージャを書いているのですが、簡単でする方法があればご教授ください。 宜しくお願いいたします。

  • こんなマクロなんですが。

    下記のマクロでエクセルの表からデータ(文字列)を取得するようにしたいとおもっています。 Range("B23").Select Selection.Copy Range("F23").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Application.CutCopyMode = False Range("B24").Select Selection.Copy Range("F24").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Range("B25").Select Application.CutCopyMode = False Sheets("September 03").Copy Before:=Sheets(2)          ←ここ Selection.Copy Sheets("September 03 (2)").Select                   ←ここ Sheets("September 03 (2)").Name = "September 10"       ←ここ Range("B33").Select Application.CutCopyMode = False ActiveWindow.SmallScroll Down:=-15 Range("F12:L18").SelectEnd Sub と、まだ続くんですが、とりあえずここまでで。 番地のデータを取り込むようにしたいんですが、うまくいきません。 ←ここ っていうのがまさにそれです。

  • エクセルマクロ実行中に固まります

    単純処理を連発させているのですが、最後まで実行されず、 途中で固まってしまいます。こういう場合はどのように 対処したらよいのでしょうか? VBAに埋め込むとよいコードなどあれば教えてください。 コードのひとかたまりは下記のようなものです。 これを100連発ほどさせます。 Range("D4:K4").Select       ...計算式がはいっています Selection.Copy Range("D5:K16").Select ActiveSheet.Paste Application.CutCopyMode = False Selection.Copy Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False

  • 色々なものを見ながら作っている初心者です。

    色々なものを見ながら作っている初心者です。 よろしくお願いします。 VBAでのエラー対処について 下記のマクロを実行すると、実行時 「Selection.Resize(, Selection.Columns.Count - 2).Select」のところで セルがブランクだった時にエラーが出てします。 対処の方法を教えていただけませんでしょうか? よろしくお願いします。 Sheets("sheetB1").Select Range("A7:C161").Select Application.CutCopyMode = False Selection.ClearContents Sheets("sheetA").Select Range("D12").Select Range(Selection, Selection.End(xlDown)).Select Range(Selection, Selection.End(xlToLeft)).Select Selection.Resize(, Selection.Columns.Count - 2).Select Selection.Offset(0, 1).Select Selection.Copy Sheets("sheetB1").Select Range("A7").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets("sheetA").Select Range("E12").Select Range(Selection, Selection.End(xlDown)).Select Selection.Copy Sheets("B1").Select Range("C7").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets("sheetB2").Select Range("A7:C161").Select Application.CutCopyMode = False Selection.ClearContents Sheets("sheetA").Select Range("J12").Select Range(Selection, Selection.End(xlDown)).Select Range(Selection, Selection.End(xlToLeft)).Select Selection.Resize(, Selection.Columns.Count - 2).Select Selection.Offset(0, 1).Select Selection.Copy Sheets("sheetB2").Select Range("A7").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets("sheetA").Select Range("K12").Select Range(Selection, Selection.End(xlDown)).Select Selection.Copy Sheets("steetB2").Select Range("C7").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=Fals

  • 実行時エラーについて

    Konkon_mと申します よろしくお願いします エクセルの質問なんですが、今回ワークシートから別のワークシートに表と数値を貼り付けるマクロを作成したのですが終了時に、『実行時エラー'1004' WorksheetクラスのPasteメソッドが失敗しました』のエラーがでるのです 一応、コピー&貼り付けはきちんと終了しているようなのですがすごく気になります 作成したマクロを載せますので、わかる方がいらっしゃいましたら教えていただけないでしょうか? 宜しくお願いします ChDir "H:\A\B" Workbooks.Open FileName:="\\PRO800\Home Directory\B\B\コピー.xls" ActiveWindow.WindowState = xlMinimized Range("B3:D10").Select Selection.Copy ActiveWindow.WindowState = xlMinimized ActiveWindow.WindowState = xlNormal ActiveWindow.WindowState = xlMinimized Windows("コピー.xls").Activate ActiveWindow.WindowState = xlNormal Range("B3").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Range("B3:D10").Select Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Range("A1").Select ActiveWorkbook.Save ActiveWindow.Close ActiveWindow.WindowState = xlNormal Range("B3").Select ActiveSheet.Paste Application.CutCopyMode = False Range("A3").Select ActiveWindow.WindowState = xlMaximized End Sub

  • マクロ実行後、画面がちかちかしない方法

    こんばんわ! VBAを実行すると、画面がちかちかします。 シートを行ったり来たりしているせいでしょうね? 自分で、色々やってみたのですが、エラーばかりで全然できません。 シートを行ったり来たりしなくてもいいVBAを作るには、どこを直せばいいでしょうか。 教えて頂けませんか? (現在のVBA) (1)「Data!FB63376,FG63376,FI63376」を「拾い出し!K4」にコピー&ペースト 値が入っている場合、下の行に貼付け。 Sub Macro1() Range("FB63376,FG63376,FI63376").Select   Range("FI63376").Activate Selection.Copy Sheets("拾い出し").Select If Range("K4").Value = "" Then Range("K4").Select Else Range("K" & Rows.Count).End(xlUp).Offset(1).Select  End If ActiveSheet.Paste Sheets("Data").Select (2)「Data!FO63367:FQ63372」を「拾い出し!O4」に値のみをコピー&ペースト 値が入っている場合、下の行に貼付け。 Range("FO63367:FQ63372").Select Selection.Copy Sheets("拾い出し").Select If Range("P4").Value = "" Then Range("P4").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Else Range("P" & Rows.Count).End(xlUp).Offset(1).Select End If Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets("Data").Select Application.CutCopyMode = False End Sub 以上です。 お分かりになる方教えて頂けませんか? 宜しくお願いします。

  • エクセルVBAでもっと早く転記

    エクセル2000です。 以下は、列をコピーし行にペーストする作業を含むVBAですが、もっとスマートに早く転記する方法がありましたらご教示ください。 お願いします。 Sub TEST() With Application .ScreenUpdating = False .Calculation = xlCalculationManual Sheets("データ").Range("B8:DH8").ClearContents With Sheets("入力") .Range("G8:G68").Copy Sheets("データ").Range("C8:BK8").PasteSpecial Paste:=xlValues, Transpose:=True .Range("G14:G15").Copy Sheets("データ").Range("BM8:BN8").PasteSpecial Paste:=xlValues, Transpose:=True Sheets("データ").Range("BQ8") = .Range("G21") Sheets("データ").Range("BR8") = .Range("G23") .Range("G25:G29").Copy Sheets("データ").Range("BS8:BW8").PasteSpecial Paste:=xlValues, Transpose:=True .Range("G32:G68").Copy Sheets("データ").Range("BX8:DH8").PasteSpecial Paste:=xlValues, Transpose:=True End With Application.CutCopyMode = False .Calculation = xlCalculationAutomatic .ScreenUpdating = True End With End Sub

  • エクセル VBA 繰り返し コピー貼り付け

    以下を繰り返し作業をOffsetを使用して行いたいのですがどうすればいいでしょうか? Sheets("Sheet1").Select Range("A1:C1").Select のA1:C1以下へA1000:C1000ぐらいあります。 Sheets("Sheet2").Select Range("G1").Select は貼り付けたセル3つの数字の組み合わせで公式に使う計算期間がまちまちですので公式を張り付けたり出来ません。 D1の解を heets("Sheet1").Select Range("D1").Select に貼り付けてA1:C1以下1000までの結果を評価出来るようにしたいのですが! ' Macro1 Macro Sheets("Sheet1").Select Range("A1:C1").Select Selection.Copy Sheets("Sheet2").Select Range("D1").Select ActiveSheet.Paste Range("G1").Select Application.CutCopyMode = False Selection.Copy Sheets("Sheet1").Select Range("D1").Select ActiveSheet.Paste Range("A2:C2").Select Application.CutCopyMode = False Selection.Copy Sheets("Sheet2").Select Range("D1").Select ActiveSheet.Paste Range("G1").Select Application.CutCopyMode = False Selection.Copy Sheets("Sheet1").Select Range("D2").Select ActiveSheet.Paste Range("A3:C3").Select Application.CutCopyMode = False Selection.Copy Sheets("Sheet2").Select Range("D1").Select ActiveSheet.Paste Range("G1").Select Application.CutCopyMode = False Selection.Copy Sheets("Sheet1").Select Range("D3").Select ActiveSheet.Paste End Sub よろしくおねがいします。

  • Excelでマクロを繰り返したい。

    Excelでマクロを記録したら以下のようになりました このマクロを以下の条件で繰り返したいのですが。 Sub Macro1() '------------- '----------------------- ' Sheets("Sheet1").Select Selection.AutoFilter Field:=4, Criteria1:="=5*", Operator:=xlAnd, _ Criteria2:="<>5@*" Range("A3:A302").Select Selection.Copy Sheets("Sheet2").Select Range("A3").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets("Sheet1").Select Range("A1").Select Selection.AutoFilter Field:=4, Criteria1:="=6*", Operator:=xlAnd, _ Criteria2:="<>6@*" Range("A3:A302").Select Selection.Copy Sheets("Sheet2").Select Range("B3").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets("Sheet1").Select Selection.AutoFilter Field:=4, Criteria1:="=7*", Operator:=xlAnd, _ Criteria2:="<>7@*" Range("A3:A302").Select Selection.Copy Sheets("Sheet2").Select Range("A103").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets("Sheet1").Select Range("A1").Select Selection.AutoFilter Field:=4, Criteria1:="=8*", Operator:=xlAnd, _ Criteria2:="<>8@*" Range("A3:A302").Select Selection.Copy Sheets("Sheet2").Select Range("B103").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False End Sub 条件= Field:は4~35位まで変動します 一連の動作をコピーして手作業で数字を変えてみたのですが プロージャが大きすぎてエラーになってしまいます。 何か良い方法は無いでしょうか?。

専門家に質問してみよう