エクセルマクロ－条件付き繰り返し

質問

マクロ初心者です。（エクセル２００３使用）

シート１にある表で、Ｍ列が空白以外（処理済みなどの値がある場合）である場合、その行全体をコピーし、シート２の最終行に貼り付けして、シート１からはその行を削除するマクロを作成したいと思っていますができません。
すみませんが、どなたかご教授願います。

（シート１の表）
・８行目が題目となっており、Ａ９から表となっています。
・表の全体サイズは、横がＡからＭまでで、縦はＣ(シー）の管理番号行分までとなっています。（Ｍは、空欄があったり値（処理済みなどの値）が入っていたりしています）

（考えているマクロ）
・Ｌｏｏｐの回数は、Ｃの管理番号が終わるまで
・ＩＦでＣに値があり、Ｍが空欄だった場合は、そのまま（何もしない）
・Ｃに値があり、Ｍに値があった場合は、その行全体を選択しコピーし、シート３の最終行に貼り付け、シート１のその行は削除する

Sub 処理済み()

Range("C9").Select

Do While ActiveCell.Value = ""
ActiveCell.Offset(1).Select
Loop

If ActiveCell.Offset(, 10).Value = "" Then
そのまま
Else If ActiveCell.Offset(, 10).Value = "値があったら" Then
その行全体を Select.Copy

Sheets("Sheet2").Select
Dim 下
下 = Range("A").End(xlDown).Row
ペースト

削除
End If

End Sub

すみませんが、どなたか教えていただけましたら助かります。
よろしくお願いいたします。

回答No.4

hige_082 · ベストアンサー

基本は最低限勉強した方がよいと思いますよ
＞・Ｌｏｏｐの回数は、Ｃの管理番号が終わるまで
初心者はdo～loopではなくfor～nextを使用した方が良いでしょう
do～loopは確実な条件を設定しないと無限ループになりやすく、扱いが難しい

行削除を伴う処理は最終行から行う方がよい
３行、４行目が削除対象だとして
上から処理を行った場合
３行目の行削除処理を行うと、４行目が３行目に移動するため
４行目が行削除処理されないままになってしまうため

上のようなことを踏まえて

Sub test()
Dim i As Long, ii As Long
ii = Worksheets("sheet2").Range("A65536").End(xlUp).Offset(1).Row
With Worksheets("sheet1")
For i = .Range("c65536").End(xlUp).Row To 9 Step -1
If .Cells(i, 3).Value <> "" And .Cells(i, 13).Value <> "" Then
Worksheets("sheet2").Rows(ii).Insert Shift:=xlDown
.Rows(i).Copy Worksheets("sheet2").Cells(ii, 1)
.Rows(i).Delete Shift:=xlUp
End If
Next i
End With
End Sub

参考程度に

お礼

ご丁寧なアドバイスを投稿いただきまして、ありがとうございます。
まだまだ分からないことが沢山あり、応用をきかすこともできない状態ですが、回答いただいたコードを理解できるよう勉強しようと思います。ご親切な回答、本当にありがとうございました。

回答No.3

yucco_chan

知ったかぶりです。
＃１さんのご意見も御もっともですが、失礼ながら質問者さんは、
＃１さんのアドバイスを実行出来るレベルに無いと感じました。

VBEを起動（alt+F11）して、F8キーを押す毎に、マクロを１Stepずつ
実行でき、ご自分で作られたマクロが何故期待動作しないかを確認、
改善すれば良いと思います。

参考に、質問者さんがやりたいと思うソースを以下に示します。
これも、1Stepずつ実行して、各命令がどのような動作をしているか
観測して、学習してください。
尚、もっとスマートなやり方もありますが、質問者さんが考えられた
方法を出来るだけ再現したつもりです。

Sub sample()

Dim i As Long
Dim j As Long

i = 9
j = 1

Do While Cells(i, 3) <> ""
　　If Cells(i, 13) <> "" Then
　　　　Rows(i & ":" & i).Copy
　　　　Sheet2.Select
　　　　Rows(j & ":" & j).Select
　　　　ActiveSheet.Paste
　　　　j = j + 1
　　　　Sheet1.Select
　　　　Rows(i & ":" & i).Select
　　　　Selection.Delete
　　　　i = i - 1
　　End If
　　i = i + 1
Loop

お礼

初心者なため初歩的な質問ですみませんでした。
ご親切な回答に感謝いたします。ありがとうございました。

回答No.2

rivoisu

ぱっとみでお答え

loop文の位置がおかしい
何もしないでルーぴしている

回答No.1

a987654

そこまで出来ているのに何が判らないのでしょうか？
実際にやってみておかしな所（分からない部分）を
質問すべきではないでしょうか？
中には、ご親切な回答者のかたもおられてプログラムを
組んでくれるかも知れませんが・・・・・