スキルアップ・問題解決なら、モーグにおまかせ！

初めて投稿させていただきます。
最近VBAを勉強し始めたばかりの素人のため、教えていただきたいです。
 
【やりたいこと】
1ファイルの中に「数字（経費）」（例：「1（経費）」）と書かれているシートが100シートあります。
毎月同様の処理をしているため、前月と同様の内容があった場合や似ている内容だった場合には、前月のファイルから類似シートを翌月のファイルにコピーすることがあります。
 
しかしながら、上記シートには「入力規則」と「VLOOKUP関数」を使用しているため、別ファイルにシートごとコピーすると「入力規則」は反映されず、「VLOOKUP関数」は元のファイルを参照する形になってしまいます。
そのため、上記（前月のファイルから似ているシートを翌月のファイルにコピー）を行った場合に「入力規則」と「VLOOKUP関数」を再設定したいと考えております。
 
本当はコピーしてきたシートだけを選択して処理できれば一番良いと思ったのですが、それをできるスキルがないため、一旦、「経費」という文言が入っているシートすべてを処理するという記述をしてみました。
※ボタンを押すことでコピーしてきたシートだけを選択して処理するのがベストです・・・（VBAに詳しくない者もいるため、開発タブからマクロ＞実行という流れは避けたいので・・）
 
エラーが起こってしまい、どこが誤っているかわからないためご相談になります。
※標準モジュールに書きました。
 
【シート内容の補足】
・種類はD列、L列、T列、AB列、AJ列、AR列、AZ列に記載されています。
・単価はE列、M列、U列、AC列、AK列、AS列、BA列に記載されています。
・小さな表がたくさん配置されているイメージで「種類」、「単価」という項目はたくさんあります。
　種類：セルD3、D12、D21,D30・・・・・D174 〜 AZ3、AZ12、AZ21,AZ30・・・・・AZ174
　単価：セルE3、E12、E21,E30・・・・・E174 〜 BA3、BA12、BA21,BA30・・・・・BA174
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub シートリセット()
 
'「経費」という文言の入っているシートを処理する
Dim WS As Worksheet
For Each WS In Worksheets
    If WS.Name Like "*経費*" Then
        'シート内をループして各文言の右隣のセルに設定されている入力規則を削除しておく
        Const 列 = 100
        Dim 行 As Long
         
        'シート内をループして「単価」と入力されているセルの1〜5個下にVLOOKUP関数をそれぞれ再設定する
        For 行 = 1 To 500
            WS.Cells.Find("単価").Offset(1, 0).ClearContents
            WS.Cells.Find("単価").Offset(2, 0).ClearContents
            WS.Cells.Find("単価").Offset(3, 0).ClearContents
            WS.Cells.Find("単価").Offset(4, 0).ClearContents
            WS.Cells.Find("単価").Offset(5, 0).ClearContents
     
            WS.Cells.Find("単価").Offset(1, 0).Formula = "=IFERROR(VLOOKUP(D4,リスト!$A:$C,2,0),"""")"
            WS.Cells.Find("単価").Offset(2, 0).Formula = "=IFERROR(VLOOKUP(D5,リスト!$E:$H,2,0),"""")"
            WS.Cells.Find("単価").Offset(3, 0).Formula = "=IFERROR(VLOOKUP(D6,リスト!$J:$M,2,0),"""")"
            WS.Cells.Find("単価").Offset(4, 0).Formula = "=IFERROR(VLOOKUP(D7,リスト!$O:$R,2,0),"""")"
            WS.Cells.Find("単価").Offset(5, 0).Formula = "=IFERROR(VLOOKUP(D8,リスト!$A:$C,2,0),"""")"
        Next
 
        For 行 = 1 To 500
            WS.Cells.Find("種類").Offset(1, 0).Validation.Delete
            WS.Cells.Find("種類").Offset(2, 0).Validation.Delete
            WS.Cells.Find("種類").Offset(3, 0).Validation.Delete
            WS.Cells.Find("種類").Offset(4, 0).Validation.Delete
            WS.Cells.Find("種類").Offset(5, 0).Validation.Delete
             
        Next
         
        'シート内をループして「種類」と入力されているセルの1〜5個下に入力規則をそれぞれ設定する
        For 行 = 1 To 500
            WS.Cells.Find("種類").Offset(1, 0).Validation.Add Type:=xlValidateList, Formula1:="=OFFSET(リスト!$A$3,0,0,COUNTA(リスト!$A$3:$A$100),1)"
            WS.Cells.Find("種類").Offset(2, 0).Validation.Add Type:=xlValidateList, Formula1:="=OFFSET(リスト!$E$3,0,0,COUNTA(リスト!$E$3:$E$100),1)"
            WS.Cells.Find("種類").Offset(3, 0).Validation.Add Type:=xlValidateList, Formula1:="=OFFSET(リスト!$J$3,0,0,COUNTA(リスト!$J$3:$J$100),1)"
            WS.Cells.Find("種類").Offset(4, 0).Validation.Add Type:=xlValidateList, Formula1:="=OFFSET(リスト!$O$3,0,0,COUNTA(リスト!$O$3:$O$100),1)"
            WS.Cells.Find("種類").Offset(5, 0).Validation.Add Type:=xlValidateList, Formula1:="=OFFSET(リスト!$A$3,0,0,COUNTA(リスト!$A$3:$A$99),1)"
        Next
 
   End If
Next
 
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
 
全然だめだめで申し訳ございません。。。
ご教示いただきたく存じます。
 
何卒よろしくお願いいたします。

投稿したものです。
もし、ボタンを押すことでコピーしてきたシートだけを選択して処理できるやり方があるのであれば、そちらをご教示いただきたく存じます。
 
恐れ入りますが、何卒よろしくお願いいたします。

(1)
問題は、他シート参照が「コピー元のブックにあるシートを参照してしまう」点ですね。
 
これは、自分自身(ブック)を参照するように変更すればよいのです。
つまり、「ブックのリンク」のリンク先を自分自身に変更するのです。
こうすれば、セルを一切変更することなく、データ参照ができるはずです。
 

<<具体的手順>>
1．コピー後のブックをいったん保存します。
2.「ブックのリンク」から「ソースの変更」を選んで、自分自身に変更してください。(*)

・参照先シートとともにコピーし、
・コピー後のシートのセルのうち入力規則ありセルだけについて、
    (SpecialCellsでxlcelltypesamevalidationを指定)
・  .Validation.Formula1で使用している"リスト(2)"を"リスト"に置換する

Sub test()
    Dim ws       As Worksheet
    Dim c        As Range
    Dim firstAddress As String
    Dim k        As Long

    Set ws = ActiveSheet

    With ws.Range("D3:AZ174")
        Set c = .Find("種類", LookIn:=xlValues)
        If Not c Is Nothing Then
            firstAddress = c.Address
            Do
                For k = 1 To 5
                    c.Offset(k, 0).Validation.Delete
                Next
                c.Offset(1, 0).Validation.Add Type:=xlValidateList, _
                    Formula1:="=OFFSET(リスト!$A$3,0,0,COUNTA(リスト!$A$3:$A$100),1)"
                c.Offset(2, 0).Validation.Add Type:=xlValidateList, _
                    Formula1:="=OFFSET(リスト!$E$3,0,0,COUNTA(リスト!$E$3:$E$100),1)"
                c.Offset(3, 0).Validation.Add Type:=xlValidateList, _
                    Formula1:="=OFFSET(リスト!$J$3,0,0,COUNTA(リスト!$J$3:$J$100),1)"
                c.Offset(4, 0).Validation.Add Type:=xlValidateList, _
                    Formula1:="=OFFSET(リスト!$O$3,0,0,COUNTA(リスト!$O$3:$O$100),1)"
                c.Offset(5, 0).Validation.Add Type:=xlValidateList, _
                    Formula1:="=OFFSET(リスト!$A$3,0,0,COUNTA(リスト!$A$3:$A$99),1)"

                Set c = .FindNext(c)
            Loop While Not c Is Nothing And c.Address <> firstAddress
        End If
    End With
End Sub

simple様
お世話になっております。
つたない説明にも関わらず、実行したい内容を理解し、解決方法を提示してくださり、誠にありがとうございます。
（１）について、具体的な手順を記載いただきありがとうございました。
「ブックのリンク」のリンク先を自分自身に変更というところ、完全に盲点でした。。。
何とか自分でコードを書き、無事リンク先を変更することができました。
次に（２）については、入力規則を再設定するコードを記述いただきありがとうございます。
検証したところ、問題なく実行することができました！！！
自分の勉強不足さを痛感いたしました。
お教えいただいたことを再度確認しながら、今後も学んでいきたいと思います。
この度は、本当にありがとうございました！！！！！