繰り返しの処理でエラーが出てしまいます。

質問

以下のマクロを組んでいるのですが、実行するとある部分でエラー表示がされてしまいます
行おうと思っていることは、
(1)修理データブック内のセルをコピーして
(2)修理報告書form内のセルにコピーすることを
繰り返そうとしています。
繰り返しをｂだけで行うとエラーが表示されないのですがｃ＝０のときは正常に動くのですが、ｃ＝１のとき（繰り返したとき）にエラーが表示されてしまいます。どうしたら解決するでしょうか？

Private Sub 検索ボタン_Click()

Workbooks.Open ("C:\Documents and Settings\デスクトップ\修理データブック.xls")
Worksheets("修理データ").Range("A1").Activate
Dim 検索セル As Range ''検索セルを探す処理
Set 検索セル = Columns(1).Find(what:=入力テキスト.Value, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlColumns, MatchByte:=False)
If Not 検索セル Is Nothing Then
検索セル.Select
For a = 1 To 15 ''繰り返し処理1　修理報告書のＢ４セルからＢ１８セルまでを埋める処理
Selection.Copy
Windows("修理報告書form.xls").Activate ''修理報告書formに貼りつけする処理
Worksheets("入力フォーム").Range("B3").Select
Selection.Offset(a, 0).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Windows("修理データブック.xls").Activate
検索セル.Select
Selection.Offset(0, a).Select
Next a

For b = 15 To 19 Step 2
Range(ActiveCell, ActiveCell.Offset(0, 1)).Select
Selection.Copy
For c = 17 To 20
Windows("修理報告書form.xls").Activate
Worksheets("入力フォーム").Range("B3").Select Selection.Offset(c, 0).Select
Selection.PasteSpecial Paste:=xlValues ←この部分でエラーが表示されます
Application.CutCopyMode = False

Windows("修理データブック.xls").Activate
検索セル.Select
Selection.Offset(0, b + 2).Select
Next c, b

どの様に回避したらよいのかを半日かけて考えたのですがどうにも分かりません。
どなたかご教授いただけますようお願いいたします

回答No.4

noname#96023

ごめんなさい、前の行でセルを選択してしまってますね

For c = 17 To 20
Windows("修理報告書form.xls").Activate
Worksheets("入力フォーム").Activate
'rangeではなくcellsで指定してしまう
cells(c, 3).Select
next c

シート上のデータを見ていないので、状況がわかりにくいのですが
セルの指定がうまくいっていないのは
ActiveCellとかSelection.Offsetを多用するため
現在のセルの位置を見失いやすくなっているからだと思えます。
bの繰り返しも問題があるようだったら見直してみてください

回答No.3

noname#96023

おかしいとは思っていたのですが

>For c = 17 To 20　　←この部分でＢ列の行を指定。B20からB23を選択することを繰り返したい
>Windows("修理報告書form.xls").Activate
>Worksheets("入力フォーム").Range("B3").Select
>Selection.Offset(c, 0).Select　
下に17セル、18セルと移動させてしまっています

こんな感じに修正しましょう
Selection.Offset(1, 0).Select

お礼

super-dog様、ご回答ありがとうございます。
早速、ご教授いただきましたとおり行いました。

>For c = 17 To 20　　←この部分でＢ列の行を指定。B20からB23を選択することを繰り返したい
>Windows("修理報告書form.xls").Activate
>Worksheets("入力フォーム").Range("B3").Select
>Selection.Offset(1, 0).Select 　←←この部分を変更しました。

すると、Ｂ４セルに貼りつけをしてしまいます。
また、繰り返しをしなくなってしまいました。

何べんも申し訳ありませんが、どうしたらよいでしょうか？？

回答No.2

noname#96023

一回目のコピーの後
Application.CutCopyMode
でセルのコピーをキャンセルしてますよね。
2回目のコピーではクリップボードが空なので
Pasteが失敗してると思われます

お礼

super-dog様、ご回答ありがとうございます。
早速行ってみたら、できました！！！
どうもありがとうございました。

付け加えての質問で恐縮なんですが、もしよろしければ教えてください。

指摘いただいた部分を削除したらエラーが出なくなったのですが、自分の思っている通り動きません。
-------------------------------
For b = 15 To 19 Step 2
Range(ActiveCell, ActiveCell.Offset(0, 1)).Select
Selection.Copy
For c = 17 To 20　　←この部分でＢ列の行を指定。B20からB23を選択することを繰り返したい
Windows("修理報告書form.xls").Activate
Worksheets("入力フォーム").Range("B3").Select
Selection.Offset(c, 0).Select　
Selection.PasteSpecial Paste:=xlValues

Windows("修理データブック.xls").Activate
検索セル.Select
Selection.Offset(0, b + 2).Select
Next c, b
--------------------------------------
この部分で、
(1)修理データブックのＰ列のセルとＱ列のセルをコピー
(2)修理報告書formのＢ20セルに貼り付け
(3)修理データブックのＲ列のセルとＳ列のセル
(4)修理報告書formのＢ２１セル（(2)で貼り付けしたセルの1行下）に貼りつけ
を繰り返しの分だけ行いたいと考えております。
ところが、今のプログラムでは、
(1)でコピーした内容をB20からB23まですべてに貼り付けて、
(3)でコピーした内容をB20からB23まですべてに貼り付ける
といったようになってしまいます。
自分ではどこが悪いのかよく分かりません。
よろしければご教授いただけませんでしょうか？

回答No.1

noname#96023

>以下のマクロを組んでいるのですが、実行するとある部分でエラー表示がされてしまいます行おうと思っていることは、
エラーを見れるのは貴方だけなのだから、
エラー内容と箇所はきちんと書きましょうよ

お礼

super-dog様
大変失礼いたしました。ご指摘ありがとうございます。
下記に修正いたします。
----------
For b = 15 To 19 Step 2
Range(ActiveCell, ActiveCell.Offset(0, 1)).Select
Selection.Copy
For c = 17 To 20
Windows("修理報告書form.xls").Activate
Worksheets("入力フォーム").Range("B3").Select Selection.Offset(c, 0).Select
Selection.PasteSpecial Paste:=xlValues ←この部分で、『RangeクラスのPastespecialメソッドが失敗しました』というエラーが表示されます
Application.CutCopyMode = False

です。これでおわかりになりますでしょうか？