エラー Nextに対するForがありませんについて

質問

VBAに慣れていないのですが、下記のマクロを組んでみました。
実行すると、コンパイルエラー　Nextに対するForがありませんと出てしまいました。
原因が良く解らないので解る方いらっしゃいましたら教えてください。

それと、もっと良い書き方などありましたらアドバイスを下さい。
よろしくお願いします。

Sub レポート作成2each()
Dim ReportMaxRow As Long '上方向に最終行を検索し行番号を格納
Dim AddWsName As String 'シート名格納
Dim Ws As Worksheet 'オブジェクト格納
Dim i As Long '繰り返しのカウントを格納
Dim flag As Boolean '真偽

ReportMaxRow = Worksheets("レポート元").Cells(Rows.Count, 1).End(xlUp).Row

For i = 2 To ReportMaxRow
If Cells(i, "N").Value <> "" Then
If Cells(i, "O").Value <> "" Then
AddWsName = Cells(i, "K").Value

For Each Ws In Worksheets
If Ws = AddWsName Then
flag = True
Next Ws　　　←ここでエラーになります。

If flag = True Then
Worksheets("レポート元").Cells(i, 1).EntireRow.Copy _
Destination:=Worksheets(AddWsName).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
Else
Worksheets.Add
ActiveWorksheet.Name = AddWsName
Worksheets("レポート元").Cells(i, 1).EntireRow.Copy _
Destination:=Worksheets(AddWsName).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
End If

MsgBox i + "行目の発注数の入力がませんでした。" & vbNewLine & "処理を中断します, _
vbOKOnly + vbExclamation, "お知らせ"
End If
Else
MsgBox i + "行目の発注数の入力がませんでした。" & vbNewLine & "処理を中断します", _
vbOKOnly + vbExclamation, "お知らせ"
End If
Next i
End Sub

回答No.4

mu2011 · ベストアンサー

NO3です。
（１）追加したFlagのリセットが誤っておりますので訂正します。
　　　Flag　=　False
（２）回答コードのシート名はシミュレート用に変更していますので元に戻して下さい。

お礼

お返事ありがとうございます。

御丁寧にソースまで作成ありがとうございました。
構築のやり方など大変参考になりました。
ありがとうございました。

また質問した際はよろしくお願いいたします。

回答No.3

mu2011

一例です。
・Msgboxの変更
・Wsのプロパティ追加
・Endifの追加
・不要なループの削除（Exit　For追加）
・Flagのリセット追加

ReportMaxRow = Worksheets("sheet1").Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To ReportMaxRow
If Cells(i, "N").Value = "" Or Cells(i, "O").Value = "" Then
MsgBox i & "行目の発注数の入力がませんでした。" & vbCrLf & "処理を中断します", _
vbOKOnly + vbExclamation, "お知らせ"
Else
AddWsName = Cells(i, "K").Value
For Each Ws In Worksheets
If Ws.Name = AddWsName Then
Exit For
End If
Next
If flag Then
Worksheets("sheet1").Cells(i, 1).EntireRow.Copy _
Destination:=Worksheets(AddWsName).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
flag = True

Else
Worksheets.Add
ActiveWorksheet.Name = AddWsName
Worksheets("sheet1").Cells(i, 1).EntireRow.Copy _
Destination:=Worksheets(AddWsName).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
End If
End If
Next i

回答No.2

FEX2053

>実行時エラー　438　オブジェクトは、このプロパティまたはメソッドをサポートしていません。

このエラーは

>Dim AddWsName As String 'シート名格納
>Dim Ws As Worksheet 'オブジェクト格納

こうなって

>If Ws = AddWsName Then　

こうなってる以上当たり前です。
"="の左右は同じ属性じゃないと比較できません。

確認してませんが多分

>If Ws.Name = AddWsName Then

で動くんじゃないかと。

補足

お返事ありがとうございます。
そうでした＾＾；ご指摘ありがとうございました。

回答No.1

andy_kun

＞For Each Ws In Worksheets
＞If Ws = AddWsName Then
＞flag = True
ここにEnd Ifがないから
＞Next Ws　　　←ここでエラーになります。

補足

早いお返事ありがとうございます。早速直してみましたが、
実行時エラー　438　オブジェクトは、このプロパティまたはメソッドをサポートしていません。
と出てしまいました。
どこが問題なのでしょうか…変数AddWsNameを入れる事が出来ないのでしょうか？

For Each Ws In Worksheets
　If Ws = AddWsName Then　←ここが黄色でマークされています。
　　flag = True
　End Iｆ
Next Ws