動きっぱなしです。止め方とプロシージャの間違いを教えて下さい！

VBA超初心者です。下記のプロシージャで実行したら、
何かがループしている様子で、VBAのオブジェクトブラウザーが
ずっと動きっぱなしになっています。
Excelもおかしく、セルを選択すると同時に入力モードになって
Ctrl+CやEscを連打して押し続けないとリボンの中が触れません。
原因はこのプロシージャだと思うのですが、どこが間違っているのか、
それによって何が起きてるのか、全く解りません。
ループらしきものを止める事も出来ません。
どなたか、止め方とプロシージャの間違いを教えて下さい。


Sub Macro1()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim saki As Long
Dim moto As Long
Set ws1 = ThisWorkbook.Worksheets("Sheet1")
Workbooks.Open ThisWorkbook.Path & "\moto.xlsx"
Set ws2 = ActiveWorkbook.Worksheets("Sheet1")
For moto = 2 To 250
For saki = 5 To 54
If ws2.Range("A" & moto).Value = ws1.Range("B" & saki).Value Then
Workbooks.Open ThisWorkbook.Path & "\moto.xlsx"
If ws2.Range("C" & moto).Value = ws1.Range("D6").Value Then
Range("D" & moto).Select
Selection.Copy
Windows("saki.xlsm").Activate
Range("D" & saki).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=True
End If
'この間にも同様なifのコードがあります
If ws2.Range("C" & moto).Value = ws1.Range("Z6").Value Then
Range("D" & moto).Select
Selection.Copy
Windows("saki.xlsm").Activate
Range("Z" & saki).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=True
End If
End If
Next
Next

For moto = 2 To 250
For saki = 5 To 44
If ws2.Range("A" & moto).Value = ws1.Range("AG" & saki).Value Then
Workbooks.Open ThisWorkbook.Path & "\moto.xlsx"
If ws2.Range("C" & moto).Value = ws1.Range("AI6").Value Then
Range("D" & moto).Select
Selection.Copy
Windows("saki.xlsm").Activate
Range("AI" & saki).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=True
End If
'この間にも同様なifのコードがあります
If ws2.Range("C" & moto).Value = ws1.Range("BE6").Value Then
Range("D" & moto).Select
Selection.Copy
Windows("saki.xlsm").Activate
Range("BE" & saki).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=True
End If
End If
Next
Next
Windows("moto.xlsx").Activate
ActiveWindow.Close False
End Sub

No.5 回答者： Qchan1962 回答日時： 2022/08/17 00:09

諸々了解です

コードだけですとイメージがわかず纏めて処理をするコードは諦めて
総当たりのループのままですが、記載されている部分を書いてみました
ws2.Range("C" & moto).Value が空白セルなんて場合もありますでしょうか？とりあえず空白セルを比較しないと思いますので処理コードを飛ばすような条件を加えました。（少しでも処理回数を減らす為）
ブック名、シート名はお礼欄をコピーしましたが、実際と確認してください
各条件がTrueの場合、それなりに処理時間がかかると思いますのでステップ実行などで試してください
処理時間を減らすなどの工夫をされたほうが良いと思いますが、なさりたい事などをコードから読むのは大変なので別質問などをされるのが良いと思われます。

Sub Macro1()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim saki As Long
Dim moto As Long
'シート名をコピーしたけれどeが抜けているような感じ
Set ws1 = ThisWorkbook.Worksheets("sampl6")
Workbooks.Open ThisWorkbook.Path & "\furyou_202207.xlsx"
Set ws2 = ActiveWorkbook.Worksheets("Sheet1")
Application.ScreenUpdating = False
Application.EnableEvents = False
For moto = 2 To 250
For saki = 5 To 54
DoEvents
If ws2.Range("C" & moto).Value <> "" Then
If ws2.Range("A" & moto).Value = ws1.Range("B" & saki).Value Then
Select Case ws2.Range("C" & moto).Value
Case ws1.Range("D6").Value
ws1.Range("D" & saki).Value = ws2.Range("D" & moto).Value
'この間にも同様なifのコードがあります
Case ws1.Range("Z6").Value
ws1.Range("Z" & saki).Value = ws2.Range("D" & moto).Value
End Select
End If
If saki <= 44 Then
If ws2.Range("A" & moto).Value = ws1.Range("AG" & saki).Value Then
Select Case ws2.Range("C" & moto).Value
Case ws1.Range("AI6").Value
ws1.Range("AI" & saki).Value = ws2.Range("D" & moto).Value
'この間にも同様なifのコードがあります
Case ws1.Range("BE6").Value
ws1.Range("BE" & saki).Value = ws2.Range("D" & moto).Value
End Select
End If
End If
End If
Next
Next
Application.ScreenUpdating = True
Application.EnableEvents = True
Workbooks("furyou_202207.xlsx").Close False
End Sub

勘違いしていたらごめんなさいです

No.4 回答者： Qchan1962 回答日時： 2022/08/16 18:39

大事な事を書き忘れました

＞ずっと動きっぱなしになっています。
このループ処理の条件がすべてTrueの場合、それなりの処理時間が必要と思われます
少しでも処理速度を上げるためにまとめて結果を出力するなどのロジック変更が必要かと思います
（全体がわからないので使えるか分かりませんがフィルタとかunionを使うとか）
また、処理条件に付いても見直せるのではないかと思います
（例えばws2.Range("C" & moto).Valueの空白セルは処理しないとか）
いずれにしても少し難しいかも知れませんね

この回答へのお礼

④取り扱っているデータは、品番・項目・数量の３つです。
　moto.xlsxは、A列2行目～250行目(品番)・C列2行目～250行目(項目)
　・D列2行目～250行目(数量)がひとつのシートにあります。
　(品番)は順不同で、同一(品番)が(項目)違いで複数回並んでいます。
　saki.xlsmは、B列5行目～54行目(品番)・6行目D列～Z列(項目)
　(数量)は(品番)行と(項目)列のマトリクスによる全セルと、
　AG列5行目～54行目(品番)・6行目AG列～BE列(項目)
　(数量)は(品番)行と(項目)列のマトリクスによる全セルが
　ひとつのシートにあります。
　(品番)は昇順で並べており、重複しません。
　上のループは、ws2:moto.xlsxのA列(品番)の？行のセル内容が
　ws1:saki.xlsmのB列(品番)の？？行目のセル内容と合致した時に
　ws2:moto.xlsxの？行目のC列(項目)のセル内容と
　ws1:saki.xlsmの6行目のD列～Z列(項目)のいずれかのセル内容と
　合致したら
　ws1:saki.xlsmの？？行目の一致した列(D列～Z列のいずれか)へ
　ws2:moto.xlsxのD列(数量)？行目のセル内容をコピーして貼る。
　下のループは、ws1:saki.xlsmの6行目のAG列～BE列のいずれかに
　変わります。

ループ処理条件が全てTrueの場合、それなりの処理時間が必要・・・
ロジックの変更・・・か・・・最初から作り直しですね

お礼日時：2022/08/16 23:38

No.3 回答者： Qchan1962 回答日時： 2022/08/16 18:05

ご質問を質問で返して申し訳ないのですが、

＞実行時エラー’1004’
は、該当ブックやシート、セル範囲などが取得できないのではないかと思います
＞If ws2.Range（”Ｃ”　＆　ｍｏｔｏ）.Value = ws1.Range（”Ｄ６”）.Value Then
全角半角を混ぜてコードを示されても原因は良く分かりませんが

①　Set ws1 = ThisWorkbook.Worksheets("Sheet1")　と
Workbooks.Open ThisWorkbook.Path & "\moto.xlsx"
Set ws2 = ActiveWorkbook.Worksheets("Sheet1")
は残していますか？

②シート名を変更していませんか？

ここも不明なままですが、教えて頂けませんか
扱うブック名と状態
ThisWorkbook　
状態と扱い：　　実行時シートをセット
コード：　Set ws1 = ThisWorkbook.Worksheets("Sheet1")

"\moto.xlsx"　
状態と扱い：　　セット時　開く
コード：　Workbooks.Open ThisWorkbook.Path & "\moto.xlsx"
Set ws2 = ActiveWorkbook.Worksheets("Sheet1")

"saki.xlsm"
状態と扱い：　アクティブにしている
コード：　Windows("saki.xlsm").Activate
？？

③　saki.xlsmは　開いている別ブック？　それとも　ThisWorkbook　の事ですか？

④　あと、上のループで変更した箇所を
下のループで参照などをして処理していますか？
見えている所には無いけれど
（'この間にも同様なifのコードがありますの中にありますか？）
For saki = 5 To 44　が違うからループ処理を重ねているだけですか？

この回答へのお礼

ブック・シート・セル範囲が取得できてないんですね。
全角半角を混ぜた理由は、当サイトの”お礼確認する”に表示された文字が
文字バケしていたので、その部分を大文字に変え直したからです。
①残しています。
②シート名は・・・ごめんなさい。変えてます。
ws1のsaki.xlsm：実際はファイルA.xlsmのsampl6というシート名です。
ws2のmoto.xlsx：実際はfuryou_202207.xlsxのSheet1というシート名です。
　ThisWorkbookは、saki.xlsmで実行時にws1へセットします。
　moto.xlsxは、ws2へセットするために直前で開いたつもりです。
　saki.xlsm コード：Windows("saki.xlsm").Activeは、
　ActiveなWindowをmoto.xlsxからsaki.xlsmへ切り替えてから
　貼り付けを行うためActiveにさせる目的です。
③saki.xlsmは、このマクロが書かれて開いているThisWorkbookです。

お礼日時：2022/08/16 23:29

No.2 回答者： Qchan1962 回答日時： 2022/08/16 13:07

＃１です

ちょっと分かり難かったかもしれません
＞どこが間違っているのか
ループで何度も同じブックを開いている
間違えでは無いけれど不要と思われるループの繰り返しがある
＞'この間にも同様なifのコードがあります　不明の為、該当しないかも
（一度処理した結果を参照している場合、該当しません）

＞止め方
＞Escを連打　して止まっているようですが・・
Workbooks.Open ThisWorkbook.Path & "\moto.xlsx"　を直せば治ると思いますが　ループ中にEscキー長押しで止めるなら、ループ内に　DoEvents　を加えるなどでしょうか
例
For saki = 5 To 44
DoEvents

その他
Windows("saki.xlsm")を.Activateでなく変数などで明示する
ThisWorkbook　と　"\moto.xlsx"　と　"saki.xlsm"　が判り難い
（不具合の可能性があります）

例えば
Workbooks.Open ThisWorkbook.Path & "\moto.xlsx"
If ws2.Range("C" & moto).Value = ws1.Range("D6").Value Then
Range("D" & moto).Select
この　Range("D" & moto).Selectはmoto.xlsxの開いたシートを指しますが
シートが明示されていないのでどのシートか分からない
ws2で良いのか？　良ければ、ws2.Range("D" & moto).Select

saki.xlsm　は　ThisWorkbook（マクロ実行ブック）でしょうか？
saki.xlsmに書き込むシートは？

この回答へのお礼

Qchan1962さん　ありがとうございます。
For shukei =5 to 54の後へDoEventsを入れたら止まったみたいです。
が、「実行時エラー’1004’：アプリケーションの定義またはオブジェクトの定義のエラー」となります。デバックの”カーソル行まで実行”にて確認すると、If ws2.Range（”Ｃ”　＆　ｍｏｔｏ）.Value = ws1.Range（”Ｄ６”）.Value Thenでエラーになる様です。最初の頃はこのコードでも動作してた様にも思うんですけど・・・。
なので代入式とかws2.Range（”Ｄ”　＆　ｍｏｔｏ）.Selectとかは試せていません。

お礼日時：2022/08/16 16:48

No.1 回答者： Qchan1962 回答日時： 2022/08/16 00:06

こんばんは

スタックするとの事なので試していませんが

Workbooks.Open ThisWorkbook.Path & "\moto.xlsx"
Set ws2 = ActiveWorkbook.Worksheets("Sheet1")

moto.xlsxのブックはすでに開かれているので
ループ内の
Workbooks.Open ThisWorkbook.Path & "\moto.xlsx"
掲示部分での2か所は要らないですね

Range("D" & saki).Select
Selection.PasteSpecial Paste:=xlPasteValues　は
値貼り付けなので　代入式にした方が良いかと

元
Range("D" & moto).Select
Selection.Copy
Windows("saki.xlsm").Activate
Range("D" & saki).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=True

例　
Windows("saki.xlsm")がThisWorkbookでTranspose:=True？
単セルだと仮定してWorkbooks.Openを踏まえると

ws1.Range("D" & saki).Value = ws2.Range("D" & moto).Value

Windows("saki.xlsm")って既に開いている別ブック？ならば、
シート不明なので

Windows("saki.xlsm").Activate
ActiveSheet.Range("D" & saki).Value = ws2.Range("D" & moto).Value
（saki.xlsm、シートも変数にセットするべきかと）

あと
'この間にも同様なifのコードがあります
との事なので良く解りませんが、処理は纏められるかもしれませんね