VBAの書き方を教えてください 3

質問

何度も申し訳ございません。

以前にもこちらで質問させて頂いている者です。
Sheet1のrange("A1")をVLOOKUPで検索後の文字を取得し、同じ名前のシートを検索し、さらにrange("A1000")をアクティブにしてここからコードをつなげて処理しています。
range("A1")の処理が終わったら、range("A2")の処理に入り、range("A3") range("A4")を続けて処理を行っているのですが、range("A4")でVLOOKUPの検索が空白の場合、On Error GoTo myErrorで次のrange("A5")の処理に入りますが、On Error Gotoは1回のみの処理しかできないみたいで、range("A５")が空白の場合、実行時エラー9が発生してしまいます。

教えて頂いたコードを解読し、On Error Resume Nextなどを使おうとしているのですが、上手くできません。
１から10まで質問しっぱなしなのですが、どなたかご協力を頂けないでしょうか。

とりあえず自分の必要なコードはある程度省いて、2つ分のみ記載します。
本来この後、10回同じ処理を行います。
よろしくお願い致します。

Private Sub 記帳_Click()

　On Error GoTo myError1
　Dim i As Long
　Dim myFlg As Boolean
　　 For i = 1 To worksheets.Count
If worksheets(i).Name = Range("A1").Value Then
myFlg = True
Exit For
End If
Next i
If myFlg = True Then
With worksheets(i)
.Activate
.Range("A1000").End(xlUp).Select
　　　ActiveCell.Offset(1, 0).Select
　 ActiveCell = Range("J1")
ActiveCell.Offset(0, 1).Select
ActiveCell = Range("K1")
End With
Else
MsgBox "該当シートなし"
End If

myError1:
On Error GoTo myError2
For i = 1 To worksheets.Count
If worksheets(i).Name = Range("A2").Value Then
myFlg = True
Exit For
End If
Next i
If myFlg = True Then
With worksheets(i)
.Activate
.Range("A1000").End(xlUp).Select
ActiveCell.Offset(1, 0).Select
　 ActiveCell = Range("J1")
ActiveCell.Offset(0, 1).Select
ActiveCell = Range("K1")
End With
Else
MsgBox "該当シートなし"
End If

End sub

回答No.2

keithin · ベストアンサー

Ａ１から順繰り処理を進めていくのでしたら、各シートをイチイチアクティブにしていく意味が全くありませんが、まぁそこは目をつむって。

sub macro1()
　dim h as range
　for each h in range("A1:A" & range("A65536").end(xlup).row)
　　if h <> "" then

　　　on error goto errhandle
　　　application.goto worksheets(h.value).range("A1000").end(xlup).offset(1), true
　　　activecell.resize(1, 2).value = range("J1:K1").value

retpos:
　　end if
　next
　exit sub

errhandle:
　msgbox "SHEET " & h.value & " NOT FOUND"
　resume retpos
end sub

＃補足
＞Sheet1のrange("A1")をVLOOKUPで検索後の文字を取得し

マクロのどこにも何もVLOOKUPしてませんので、まぁご説明の無いどこかでうまくできてる事にします。

お礼

keithinさん。

前回同様、ご協力ありがとうございます。
msgbox "SHEET " & h.value & " NOT FOUND"　が大変役立つコードを教えて頂きましたので、使わせて頂きます。
また、大変シンプルで新しく考え方を見直す良いチャンスでした。

前回同様ですが、また何かあればよろしくお願いします。

回答No.3

mt2008

ANo.1です。

補足みました。
こんな感じで良いんじゃないでしょうか。

Private Sub 記帳_Click()
　　On Error Resume Next 'エラーが発生したら次の行から再開
　　For i = 1 To 13 'A1～A13までを対象
　　　　nCount = 0
　　　　'A列のセルの名前のシートが無いと、エラーになるのでnCountは0のまま
　　　　nCount = Worksheets(Cells(i, 1).Value).Index
　　　　If nCount > 0 Then 'nCount が0じゃ無いならシートは有る
　　　　　　With Worksheets(Cells(i, 1).Value)
　　　　　　　　nLast = .Range("A1000").End(xlUp).Row + 1
　　　　　　　　.Range("A" & nLast).Resize(1, 5).Value = Range("J1:N1").Value
　　　　　　End With
　　　　End If
　　Next i
End Sub

お礼

mt2008さん。
ありがとうございました。

既存のコードをベースにして頂き、また説明までつけて頂き理解しきれなかったコードが少しわかってきました。
もう少し勉強して行きたいと思います。
また何かあれば、よろしくお願いいたします。

回答No.1

mt2008

前の質問のリンクが無いことも有り、やりたい事が良く解らなかったのですが、こういう事でしょうか。
J1、K1セルは、どこのシートのJ1、K1セルか解らなかったので、マクロを起動した時アクティブなシートのセルとしました。
検索したシートのJ1、K1セルにしたい場合は、
= Range("J1")　→　= .Range("J1")　の、様に変えて下さい。

Private Sub 記帳_Click()
　　For i = 1 To 10
　　　　myFlg = False
　　　　For j = 1 To Worksheets.Count
　　　　　　If Worksheets(j).Name = Cells(i, 1).Value Then
　　　　　　　　myFlg = True
　　　　　　　　Exit For
　　　　　　End If
　　　　Next j
　　　　If myFlg = True Then
　　　　　　With Worksheets(j)
　　　　　　　　nLast = .Range("A1000").End(xlUp).Row
　　　　　　　　.Cells(nLast + 1, 1) = Range("J1")
　　　　　　　　.Cells(nLast + 1, 2) = Range("K1")
　　　　　　End With
　　　　End If
　　Next i
End Sub

補足

ご協力ありがとうございます。
先のリンク忘れていました。
１．http://oshiete.goo.ne.jp/qa/8451754.html
２．http://oshiete.goo.ne.jp/qa/8489481.html

詳細を記載いたします。
資材算出と言うシートがあり、ある情報を入力するとA1～A13までのセルに入力したVLOOKUP関数で、資材名が表示されます。別のコードにて資材に関する情報をJ1、K1、L1、M1、N1などに表示させています。
（ここまではできています）
A1～A13までの表示された資材（VLOOKUP関数での表示なので、資材がない場合は空白を表示しています）と同じ名前のシートを同じブックから探し出し、A1000を指定→A列の最終行を指定→J1からN1までの情報をA列から右セルに移動しながら入力させる（この部分を２つ分のみ表記しています）→これをA1からA13まで順に繰り返す。

この様な内容です。
質問に書きました様に、空白が２つ続くと実行時エラー9で止まってしまいます。

宜しくお願いいたします。