[[20210318223052]]　『オブジェクト変数または With ブロック変数が設定』（初心者）　ページの最後に飛ぶ

『オブジェクト変数または With ブロック変数が設定されていません』（初心者）

どこがエラーなのか表示されないのでわかりません。
A１に文字も入れています。
お願いします。

Sub kensaku()
Dim I As Long, key As Range

Sheets("各自一覧").Range("B3").CurrentRegion.Delete
For I = 1 To Worksheets.Count
If Worksheets(I).name <> "各自一覧" Then

With Worksheets(I)
Set key = .Range("B1:B100").Find(what:=Sheets("各自一覧").Range("A1").Value, lookat:=xlPart)

key.Offset(-8, 0).Resize(11, 4).Copy
Sheets("各自一覧").Cells(Rows.Count, 2).End(xlUp).Offset(2).PasteSpecial xlPasteAll
On Error Resume Next

Set key = .Range("F1:F100").Find(what:=Sheets("各自一覧").Range("A1").Value, lookat:=xlPart)
key.Offset(-8, 0).Resize(11, 4).Copy
Sheets("各自一覧").Cells(Rows.Count, 6).End(xlUp).Offset(2).PasteSpecial xlPasteAll
On Error Resume Next

Set key = .Range("J1:J100").Find(what:=Sheets("各自一覧").Range("A1").Value, lookat:=xlPart)
key.Offset(-8, 0).Resize(11, 4).Copy
Sheets("各自一覧").Cells(Rows.Count, 10).End(xlUp).Offset(2).PasteSpecial xlPasteAll
On Error Resume Next

Set key = .Range("N1:N100").Find(what:=Sheets("各自一覧").Range("A1").Value, lookat:=xlPart)
key.Offset(-8, 0).Resize(11, 4).Copy
Sheets("各自一覧").Cells(Rows.Count, 14).End(xlUp).Offset(2).PasteSpecial xlPasteAll
On Error Resume Next

End With
End If
Next

End Sub

＜使用 Excel：Excel2016、使用 OS：Windows10 ＞

     Set key = .Range("B1:B100").find(what:=Sheets("各自一覧").Range("A1").Value, lookat:=xlPart)
     If Not key Is Nothing Then
         key.Offset(-8, 0).Resize(11, 4).Copy
         Sheets("各自一覧").Cells(Rows.Count, 2).End(xlUp).Offset(2).PasteSpecial xlPasteAll
     End If
 のようにしてみて下さい。
 On Error Resume Nextはエラーを隠蔽してしまうので、
 安易に使わない方がよいと思います。　
（γ） 2021/03/18(木) 23:07

ありがとうございます。治りました。
なんでもエラーを飛ばしてくれる思って
On Error Resume Nextを安易に使いすぎました。
（初心者） 2021/03/19(金) 02:57

質問自体は、既に解決しているとおもいますが、ちょっと気になるのでコメントしておきます。

■１
＞どこがエラーなのか表示されないのでわかりません。
タイトル自体がエラーの内容です。

要は↓で、Findメソッドを実行した結果、条件にあう【セル】が見つからず、「key」にNothingが格納され、

 Set key = .Range("B1:B100").Find(what:=Sheets("各自一覧").Range("A1").Value, lookat:=xlPart)

↓でNothingを操作しようとしたので、エクセル君がそんなセルありません！って警告しています。

 key.Offset(-8, 0).Resize(11, 4).Copy

なので↓のように、「key」がNothingじゃないことを判定して、真のときだけ処理をするように変更すべきだとアドバイスされたわけです。

 If Not key Is Nothing Then

■２

 ～.PasteSpecial xlPasteAll

↑のように、PasteSpecialメソッドの引数に「xlPasteAll」を指定してますが、それだと普通の貼付（Pasteメソッド）とほぼ同じです。
そして、普通の貼付で問題なければ、Copyメソッドの引数に貼付先を指定することで、貼付操作まで1行で完結させることが可能です。

 key.Offset(-8, 0).Resize(11, 4).Copy
 Sheets("各自一覧").Cells(Rows.Count, 2).End(xlUp).Offset(2).PasteSpecial xlPasteAll

              ↓ほぼ同じ結果

 Key.Offset(-8, 0).Resize(11, 4).Copy Sheets("各自一覧").Cells(Rows.Count, 2).End(xlUp).Offset(2)

■３
今回のケースで言えば、私もkeyがNothingじゃないときだけ処理するようにすべきだとおもいますが、keyがNothingになるとき（つまり、該当するセルが無いとき）には処理しないのであれば、「On Error Resume Next」でも間違いではないとおもいます。
ただ、記述位置がおかしいです。

「On Error Resume Next」はエラーが発生した場合、無視して次の行へ進む命令です。
そして、「■１」で示したように、エラーが出るとすれば↓の行です。

 key.Offset(-8, 0).Resize(11, 4).Copy

すなわち、ここより先に書かれていなければならないのに、後に書かれちゃっているのが問題です。
また、「On Error Goto 0」で戻さなければ、そのままなので、何度も「On Error Resume Next」を記述する必要はありません。

■４
提示されたコードでは、インデントがついていません。
VBAのコードを実行する上ではインデントに意味はないので、付ける付けないは最終的にはご自身が決めればよいですが、誰かに見てもらったり、メンテナンスをする際にはあったほうがよいとおもうので、こだわりがなければ、インデントを付けることをお勧めします。

■５
また、Findメソッドについて「LookAt」は指定してますが、「LookIn」は省略しています。
Findメソッドのいくつかの引数には、省略した場合、前回値を承継するとみなすものがありますから、「LookIn」「LookAt」あたりは指定するようにしたほうが良いと思います。

■６
以上をふまえると↓みたいな感じでもよかったとおもいます。

   Sub kensaku_を整理1()
      Dim I As Long, key As Range

      Stop 'ブレークポイントの代わり
      With Sheets("各自一覧")
         .Range("B3").CurrentRegion.Delete

         On Error Resume Next
         For I = 1 To Worksheets.Count
            If Worksheets(I).Name <> .Name Then

               Set key = Worksheets(I).Range("B1:B100").Find(what:=.Range("A1").Value, LookIn:=xlValues, lookat:=xlPart)
               key.Offset(-8, 0).Resize(11, 4).Copy .Cells(Rows.Count, 2).End(xlUp).Offset(2)

               Set key = Worksheets(I).Range("F1:F100").Find(what:=.Range("A1").Value, LookIn:=xlValues, lookat:=xlPart)
               key.Offset(-8, 0).Resize(11, 4).Copy .Cells(Rows.Count, 6).End(xlUp).Offset(2)

               Set key = Worksheets(I).Range("J1:J100").Find(what:=.Range("A1").Value, LookIn:=xlValues, lookat:=xlPart)
               key.Offset(-8, 0).Resize(11, 4).Copy .Cells(Rows.Count, 10).End(xlUp).Offset(2)

               Set key = Worksheets(I).Range("N1:N100").Find(what:=.Range("A1").Value, LookIn:=xlValues, lookat:=xlPart)
               key.Offset(-8, 0).Resize(11, 4).Copy .Cells(Rows.Count, 14).End(xlUp).Offset(2)
            End If
         Next I
         On Error GoTo 0
      End With
   End Sub

■７
さらに、どうも列が４つずつずれていく以外は同じようなので↓のようにループ処理に変えてもよいかもです。

   Sub kensaku_を整理2()
      Dim I As Long, key As Range, 列 As Long

      Stop 'ブレークポイントの代わり
      With Sheets("各自一覧")
         .Range("B3").CurrentRegion.Delete

         On Error Resume Next
         For I = 1 To Worksheets.Count
            If Worksheets(I).Name <> .Name Then

               For 列 = 2 To 14 Step 4
                  Set key = Intersect(Worksheets(I).Rows("1:100"), Worksheets(I).Columns(列)).Find(what:=.Range("A1").Value, LookIn:=xlValues, lookat:=xlPart)
                  key.Offset(-8, 0).Resize(11, 4).Copy .Cells(Rows.Count, 列).End(xlUp).Offset(2)
               Next 列

            End If
         Next I
         On Error GoTo 0
      End With
   End Sub

以上、長々と失礼しました。

（もこな２） 2021/03/20(土) 14:23

コメント返信：

[ 一覧(最新更新順) ]

[[20210318223052]] 『オブジェクト変数または With ブロック変数が設定』（初心者） ページの最後に飛ぶ

[[20210318223052]]　『オブジェクト変数または With ブロック変数が設定』（初心者）　ページの最後に飛ぶ