『入力規則を繰り返したい』（りこ）

こんにちは。入力規則を23行おきに200回繰り返したいので、ネットやVBA辞典を参考に、コードをそれぞれ書いてみましたが、どうやって繋げればいいのかわかりません。

【入力規則】
Sub 入力規則1()

    Range("D4").Select
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateList, _
             Formula1:="=Sheet2!$A$2:$A$11"
    End With
End Sub

【繰り返す】
Sub 繰り返し()
Dim i as integer
For i = 4 To 4000 Step 23　’23行ごとに繰り返します。
    Range ("Di")
Next i


上の2つのコードをまとめたいです。

また、最終的には23行分の入力規則を200回繰り返すコードを作りたいです。
＊入力規則の設定はD4からD26まで、Sheet2のA2:A5〜W2:W11を参照します。
これを下の方向に200回繰り返します。参照先のSheet2の最終行はA列からW列までばらばらです。

【入力規則】
    Range("D4").Select
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateList, _
             Formula1:="=Sheet2!$A$2:$A$5"
    End With
    Range("D5").Select
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateList, _
             Formula1:="=Sheet2!$B$2:$B$6"
    End With
    Range("D6").Select
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateList, _
             Formula1:="=Sheet2!$C$2:$C$10"
    End With

−中略

    Range("D26").Select
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateList, _
             Formula1:="=Sheet2!$W$2:$W$11"
    End With

【繰り返す】
Sub 繰り返し()
Dim i as integer
For i = 4 To 4000 Step 23　’23行ごとに繰り返します。
    Range ("Di")
Next i
For j = 5 To 4000 Step 23　’23行ごとに繰り返します。
    Range ("Dj")
Next j
For k = 6 To 4000 Step 23　’23行ごとに繰り返します。
    Range ("Dk")
Next k
ー中略
For ae = 26 To 4000 Step 23　’23行ごとに繰り返します。
    Range ("Dae")
Next ae

分かりにくい説明で申し訳ありません。
ご教授お願い致します。



＜ 使用 Excel：Excel2010、使用 OS：Windows10 ＞
----
 この入力規則を設定しなければいけないシートのレイアウトというか、逆、なぜ、このような入力規則が必要になるかという
 そのレイアウト要件がピンとこないのですが、さておき。

 条件のリストで与える範囲の行数が一定ではなく、かといって増加分が一定ということでもないですね。
 与えるリスト範囲の条件を教えていただけませんか？

（β） 2016/10/30(日) 16:34
----
 こんにちわ。

 ループの部分はD4:D26を下に丸ごとコピペでは問題あるんですか？

 後リスト範囲はそれぞれのデータのある最終行までですか？
 以下のような感じかな？
 200回繰り返すなら最終行は4626じゃないですか？

 Sub test()
    Dim i As Integer
    Dim ads As String
 
    For i = 4 To 26
        With Sheets("Sheet2")
            ads = "=" & .Range(.Cells(2, i - 3), .Cells(Rows.Count, i - 3).End(xlUp)).Address(External:=True)
        End With
        With Range("D" & i).Validation
            .Delete
            .Add Type:=xlValidateList, Formula1:=ads
        End With
    Next i
    Range("D4:D26").Copy Range("D27:D4626")

 End Sub

 コード修正(18:49)

（sy） 2016/10/30(日) 16:54
----
 >>後リスト範囲はそれぞれのデータのある最終行までですか？

 あぁ、なるほど。そうかも。
 だから規則性がなかったんですね。


（β） 2016/10/30(日) 18:08
----
βさん、syさん、こんにちは。私の拙い説明を読み取ってくださり、ありがとうございます。
また、お礼が遅くなりごめんなさい。

結局、23行分の入力規則を手作業で設定し、syさんにアドバイスいただいたコピペをアレンジしました。
＊syさんのご指摘通り、4626行でした。

Range("G4:G26").Copy

Range("G27:G4626").PasteSpecial Paste:=xlPasteValidation

本当に助かりました。ありがとうございました。
（りこ） 2016/11/06(日) 17:29