実行時エラー'1004''Range'メソッドは失敗しました:'_Worksheet'オブジェクト

仕事でExcelで資料を作成しています。資料上の操作はダブルクリックでセルを選択。選択したセルの内容が別のセルに表示されるようにしたいのですが、一部Range指定範囲が不連続で文字数制限も超えてしまうため以下のようなマクロを組みました。しかしエラーが出てしまいます。どうにも解決策がわからないので教えていただけたらと思います。長いマクロで見にくいと思いますが、よろしくお願いします。
（B～Fを1ブロックとして以降列も同様の考え方。B列セルのダブルクリックで対応するF列セルの内容も別セルに。D列とE列はセルを結合している行があるので、その部分はどちらをダブルクリックしても構わないようにしています）

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

Dim rS1rc, rS2rc, rS3rc, rS4rc As Range

Dim rD1st, rD2st, rD3st, rD4st As Range

Dim r1, r2, r3, r4, rV As Range

Dim rd1, re1, ri1, rj1, rn1, ro1, rs1, rt1, rx1, ry1, rac1, rad1, rah1, rai1 As Range
Dim rd2, re2, ri2, rj2, rn2, ro2, rs2, rt2, rx2, ry2, rac2, rad2, rah2, rai2 As Range

Set rS1rc = Me.Range("B27:B110,G27:G110,L27:L166,Q27:Q166,V55:V166,AA55:AA166,AF69:AF166")
Set rS2rc = Me.Range("C27:C110,H27:H110,M27:M166,R27:R166,W55:W166,AB55:AB166,AG69:AG166")
Set rd1 = Me.Range("D27:D110")
Set re1 = Me.Range("E27:E35,E41:E49,E55:E63,E69:E77,E83:E91,E97:E105")
Set ri1 = Me.Range("I27:I110")
Set rj1 = Me.Range("J27:J35,J41:J49,J55:J63,J69:J77,J83:J91,J97:J105")
Set rn1 = Me.Range("N27:N166")
Set ro1 = Me.Range("O27:O35,O41:O49,055:O63,O69:O77,O83:O91,O97:O105,O111:O119,O125:O133,O139:O147,O153:O161")
Set rs1 = Me.Range("S27:S166")
Set rt1 = Me.Range("T27:T35,T41:T49,T55:T63,T69:T77,T83:T91,T97:T105,T111:T119,T125:T133,T139:T147,T153:T161")
Set rx1 = Me.Range("X55:X166")
Set ry1 = Me.Range("Y55:Y63,Y69:Y77,Y83:Y91,Y97:Y105,Y111:Y119,Y125:Y133,Y139:Y147,Y153:Y161")
Set rac1 = Me.Range("AC55:AC166")
Set rad1 = Me.Range("AD55:AD63,AD69:AD77,AD83:AD91,AD97:AD105,AD111:AD119,AD125:AD133,AD139:AD147,AD153:AD161")
Set rah1 = Me.Range("AH69:AH166")
Set rai1 = Me.Range("AI69:AI77,AI83:AI91,AI97:AI105,AI111:AI119,AI125:AI133,AI139:AI147,AI153:AI161")
Set rS3rc = Union(rd1, re1, ri1, rj1, rn1, ro1, rs1, rt1, rx1, ry1, rac1, rad1, rah1, rai1)
Set rd2 = Me.Range("D27:D35,D41:D49,D55:D63,D69:D77,D83:D91,D97:D105")
Set re2 = Me.Range("E27:E110")
Set ri2 = Me.Range("I27:I35,I41:I49,I55:I63,I69:I77,I83:I91,I97:I105")
Set rj2 = Me.Range("J27:J110")
Set rn2 = Me.Range("N27:N35,N41:N49,N55:N63,N69:N77,N83:N91,N97:N105,N111:N119,N125:N133,N139:N147,N153:N161")
Set ro2 = Me.Range("O27:O166")
Set rs2 = Me.Range("S27:S35,S41:S49,S55:S63,S69:S77,S83:S91,S97:S105,S111:S119,S125:S133,S139:S147,S153:S161")
Set rt2 = Me.Range("T27:T166")
Set rx2 = Me.Range("X55:X63,X69:X77,X83:X91,X97:X105,X111:X119,X125:X133,X139:X147,X153:X161")
Set ry2 = Me.Range("Y55:Y166")
Set rac2 = Me.Range("AC55:AC63,AC69:AC77,AC83:AC91,AC97:AC105,AC111:AC119,AC125:AC133,AC139:AC147,AC153:AC161")
Set rad2 = Me.Range("AD55:AD166")
Set rah2 = Me.Range("AH69:AH77,AH83:AH91,AH97:AH105,AH111:AH119,AH125:AH133,AH139:AH147,AH153:AH161")
Set rai2 = Me.Range("AI69:AI166")
Set rS4rc = Union(rd2, re2, ri2, rj2, rn2, ro2, rs2, rt2, rx2, ry2, rac2, rad2, rah2, rai2)

Set rD1st = Me.Range("B14:B23")
Set rD2st = Me.Range("C14:C23")
Set rD3st = Me.Range("D14:D23")
Set rD4st = Me.Range("E14:E23")
Set rVAst = Me.Range("F14:F23")

If Not Intersect(Target, rS1rc) Is Nothing Then
If Application.CountA(rD1st) = rD1st.Cells.Count Then
Else
Set r1 = rD1st.Cells(1)
On Error Resume Next
Set r1 = rD1st.SpecialCells(xlCellTypeBlanks).Cells(1)
On Error GoTo 0
r1.Value = Target.Value
End If
Cancel = True
End If
Set rS1rc = Nothing
Set rD1st = Nothing
（上のルーチンをルーチン１とします）

If Not Intersect(Target, rS2rc) Is Nothing Then
If Application.CountA(rD2st) = rD2st.Cells.Count Then
Else
Set r2 = rD2st.Cells(1)
On Error Resume Next
Set r2 = rD2st.SpecialCells(xlCellTypeBlanks).Cells(1)
On Error GoTo 0
r2.Value = Target.Value
If Application.CountA(rVAst) = rVAst.Cells.Count Then
Else
Set rV = rVAst.Cells(1)
On Error Resume Next
Set rV = rVAst.SpecialCells(xlCellTypeBlanks).Cells(1)
On Error GoTo 0
rV.Value = Target.Cells(1, 1).Offset(0, 3)
End If
End If
Cancel = True
End If
Set rS2rc = Nothing
Set rD2st = Nothing

（ここにルーチン１の変数部分を３及び４に換えたルーチン3とルーチン4があります）

End Sub

質問者からの補足コメント

• おっしゃる通りです。社外秘のデータを含んでいたため新しい画像を作りました。
  動作としては、27行目以降をダブルクリック（画像にある部分が1ブロックになります）で選択すると、その内容がB13～F23までの表に上から該当する列に埋められていくようになります。
  呼称寸法を選択後に材質を選択。材質を選択すると自動で該当単価も転記されます（質問内容は呼称寸法の選択で、となっているので間違えてます）。
  内外面同一処理のところはセルを結合してるのでどちらのセル範囲がダブルクリックされても有効にしています。
  縦横寸法の組み合わせが数種類あり、それぞれに同じブロックを行列方向に作ってますが、横寸法が小さい場合は縦寸法の大きいものは無く、横が大きいと縦の小さいのは無いため、ブロックが階段状に並んでいます。
  以上、なにとぞよろしくお願いします。

  
  No.1の回答に寄せられた補足コメントです。 補足日時：2020/03/16 12:25

No.3 回答者： ママチャリ 回答日時： 2020/03/16 20:40

No.1です。

補足して頂いたにも関わらず、やっぱり、やりたいことが見えませんでした。
このままでは申し訳ないので、何とか解決策を見つけたいのですが・・・。
ちなみに、実行時エラーって、どのステートメントで発生するのですか？

この回答へのお礼

ありがとうございました。もうひと方のデバッグで見つけていただいた誤記を修正して解決できました。
解決策を見つけようとしていただき、本当にありがとうございました。また、内容をお伝えするだけの説明力がなくて、申し訳ありませんでした。
お世話になりました。
また、何かありましたら、何卒よろしくお願いいたします。

お礼日時：2020/03/17 18:20

No.2 回答者： Zincer 回答日時： 2020/03/16 12:57

動作確認（デバッグモード）で１つ間違いを見つけました。

Set ro1 = Me.Range("O27:O35,O41:O49,055:O63,O69:O77,O83:O91,O97:O105,O111:O119,O125:O133,O139:O147,O153:O161")

の「O55:O63」とすべきなのでしょうが、「055:O63」となっています。
55の前がＯ（オー）ではなく、０（ゼロ）となっています。

あとは、頑張ってください。

この回答へのお礼

ありがとうございます！その通りでした！
正確に入力してるつもりでしたので、まったく気づきませんでした…
おかげで解決しました。
ありがとうございました。

お礼日時：2020/03/17 18:16

No.1 回答者： ママチャリ 回答日時： 2020/03/15 16:43

回答で無くて申し訳ないのですが、文章と画像で、やりたいことを説明してもらうことって、できますか？

「選択したセルの内容が別のセルに表示されるようにしたい」だけでは・・・。
こんなダラダラ書かれたソースを見せられても解析する気力が湧いてきませんし。
このままでは、有効な回答は期待できませんよ（これと同様の回答は付くかもしれないですが・・）