VBA 特定の行を別シートに切り取りしたい

Question

予定表を作成しております。
完了した予定ついて履歴を残したいので、ボタンをクリックするとシート１のU列に「完了」
と記入されている行をシート２の3行目～に転記(切り取り)されるものを作成したいです
シート2にはシート１の完了した予定がどんどん転記されるイメージです。

【シート１】
B列の8行目からAM列の307行(B8:AM307)を使用した予定表があります。
予定が完了した行についてはU列に「完了」と記入しています。

【シート2】
シート1のU列に完了と記入されている行をシート２のB列3行目～に転記したいです。

自分なりに調べてみたのですが下記のコードだと中途半端な行しか転記されません。
ご教授お願い致します。

Private Sub kanryou_Click()
Dim i, LastRow As Long
LastRow = Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To LastRow
If Cells(i, 21) = "完了" Then
Rows(i).Cut Sheets("完了分").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
End If
Next i
End Sub

Answer 1

こちらになります。こちらでは簡単な確認しか行っていません。
特に各列の細かい確認（関数式の列とそうでない列の確認）はしていません。
あなたのほうで、詳細の確認をお願いします。

Private Sub kanryou_Click()
    Const endRow As Long = 307
    Const startRow As Long = 8
    Dim wrow As Long, LastRow As Long
    Dim fromRow As Long
    Dim toRow As Long
    Dim sh1 As Worksheet
    Dim sh2 As Worksheet
    Dim dicT As Object      '完了の行番号記憶
    Dim ctr As Long         '完了の件数
    Set dicT = CreateObject("Scripting.Dictionary") ' 連想配列の定義
    Set sh1 = Worksheets("予定表")
    Set sh2 = Worksheets("完了分")
    LastRow = sh2.Cells(Rows.Count, "B").End(xlUp).Row + 1
    If LastRow < 3 Then LastRow = 3
    ctr = 0
    For wrow = startRow To endRow
        If sh1.Cells(wrow, "U") = "完了" Then
            sh1.Range("B" & wrow & ":AM" & wrow).Copy sh2.Range("B" & LastRow & ":AM" & LastRow)
            sh1.Cells(wrow, "U") = ""
            ctr = ctr + 1
            If ctr = 1 Then
                toRow = wrow
                fromRow = wrow
            End If
            dicT(wrow) = True
            LastRow = LastRow + 1
        End If
    Next wrow
    If ctr = 0 Then
        MsgBox ("完了行なし")
        Exit Sub
    End If
    Do While (toRow < endRow)
        fromRow = get_from_row(dicT, endRow, fromRow + 1)
        If fromRow = -1 Then
            Exit Do
        End If
        Call move_line(sh1, toRow, fromRow)
        toRow = toRow + 1
    Loop
    For wrow = endRow - ctr + 1 To endRow
        Call clear_line(sh1, wrow)
    Next
    MsgBox (ctr & "行 処理完了")
End Sub

Private Function get_from_row(ByVal dicT As Object, ByVal endRow As Long, ByVal fromRow As Long) As Long
    get_from_row = -1
    Do
        If fromRow > endRow Then Exit Function
        If dicT.Exists(fromRow) = False Then
            get_from_row = fromRow
            Exit Function
        End If
        fromRow = fromRow + 1
    Loop
End Function

Private Sub move_line(ByVal ws As Worksheet, ByVal toRow As Long, ByVal fromRow As Long)
    ws.Range("B" & toRow).Value = ws.Range("B" & fromRow).Value
    ws.Range("C" & toRow).Value = ws.Range("C" & fromRow).Value
    ws.Range("E" & toRow).Value = ws.Range("E" & fromRow).Value
    ws.Range("G" & toRow & ":U" & toRow).Value = ws.Range("G" & fromRow & ":U" & fromRow).Value
    ws.Range("AJ" & toRow).Value = ws.Range("AJ" & fromRow).Value
    ws.Range("AL" & toRow).Value = ws.Range("AL" & fromRow).Value
End Sub

Private Sub clear_line(ByVal ws As Worksheet, ByVal toRow As Long)
    ws.Range("B" & toRow).ClearContents
    ws.Range("C" & toRow).ClearContents
    ws.Range("E" & toRow).ClearContents
    ws.Range("G" & toRow & ":U" & toRow).ClearContents
    ws.Range("AJ" & toRow).ClearContents
    ws.Range("AL" & toRow).ClearContents
End Sub

Comments

[abc-.-cba]

ありがとうございます。想像していた通りの予定表になりました。
頂いたコードを元により良いものを作成したいと思います。
長期に渡りありがとうございました。
大変助かりました。

Answer 2

＞可能であればシート１の空白になっている行を上に繰り上げできれば嬉しいです。
①②のどちらのケースでしょうか。
これが、切り取り前の状態です。

これが切り取り直後です。11行と14行が空白になります。

①空白行を上に移動します。（こちらがあなたが提示した内容）

②空白行を下に移動します。（念のため、こちらではないことの確認）

Comments

[abc-.-cba]

わかりやすくご説明ありがとうございます。
②を想定していました。言葉足らずで申し訳ございません。

Answer 3

オートフィルターで抽出して、
コピペしたら、ループをVBAで書く必要がなくなります。
ただし、表にタイトル行が必要になります。

この方法でやるなら、マクロの記録をしてみるところから始めます。
また、サンプルがネット上にありそうな気がします。

また、フィルターオプションの機能で抽出すれば、
VBAのコードがさらに少なるかもしれません。
シート上を汚すことにはなりますが。。。。

あ、コピペじゃなくて、移動なんですかね。
なら、オートフィルターですね。

Answer 4

これでどうでしょうか。

Private Sub kanryou_Click()
    Dim wrow As Long, LastRow As Long
    Dim sh1 As Worksheet
    Dim sh2 As Worksheet
    Set sh1 = Worksheets("Sheet1")
    Set sh2 = Worksheets("完了分")
    LastRow = sh2.Cells(Rows.Count, "B").End(xlUp).Row + 1
    If LastRow < 3 Then LastRow = 3
    For wrow = 8 To 307
        If sh1.Cells(wrow, 21) = "完了" Then
            sh1.Range("B" & wrow & ":AM" & wrow).Cut sh2.Range("B" & LastRow & ":AM" & LastRow)
            LastRow = LastRow + 1
        End If
    Next wrow
End Sub

Comments

[abc-.-cba]

tatsu99さん

ご回答ありがとうございます！！
せっかくご回答頂いたのですがPCが週明けにしか触れない為、週明けに教えて頂いたコードを使用させて頂こうと思います。

[abc-.-cba]

tatsu99さん

遅くなり申し訳ございません。ご教授頂きましたコードで上手く動作しました。
ありがとうございました。
ちなみにお手数でなければ２点ほど教えて頂きたいことがあります。
・切り取りする列の範囲をC～D、H~Qに指定したい時はどのように変更すれば宜しいでしょうか。
・シート1の切り取りを「値のみ」の切り取りにすることは可能でしょうか。

お手数おかけしますがご教授頂けると幸いです。

[tatsu99]

切り取ったデータの貼り付け先もC～D、H~Qで良いのでしょうか。
対象がU列がないので完了の文字が残りますがよいのですか。
又、現在完了分のシートの最終行判断をB列でやっていますが、それをC列にする必要があります。
前のマクロとの関連はどうなりますか。
シート1の切り取りを「値のみ」にするということは、そこに関数式があり関数式を残したいということでしょうか？
書式設定を残すことは可能ですが、関数式は残りません。
従って、見た目を空白にして、関数式を残すことはできません。

[tatsu99]

もし、前のマクロを一切使わないということであれば、U列の完了の扱い及び最終行の決定の問題は解決します。もし、前のマクロを使うのなら、どのように前のマクロとこれから作るマクロ（C～D、H~Q対応版）
を使い分けるのか提示てください。
シート1の切り取りを「値のみ」にする件ですが、特定の列のみ関数式であれば、以下の条件が成立すれば対応可能です。
例としてC列、D列のみ関数式が埋め込まれているとします。
C列、D列はカットではなく転記先へコピーします。
H～Qは転記先へコピーし、その後、その内容をクリアします。
C列、D列の関数式はH～Qのどれかの列が空白なら、空白を表示するようにします。（関数式の修正が必要になる可能性あり）

[tatsu99]

＞・シート1の切り取りを「値のみ」の切り取りにすることは可能でしょうか。
具体的にどのようにされたいのでしょうか。現状でどのように不都合なのでしょうか。そのあたりを具体的に説明していただけると良い回答が得られやすくなるかと思います。

[abc-.-cba]

シート2の名前を「完了分」としました。
お忙しい中、ご回答ありがとうございます。

・切り取りする列の範囲をC～D、H~Qに指定したい時はどのように変更すれば宜しいでしょうか。
＞こちらに関してはご教授頂いたコードをコピーに変えてみました。
特定の列のみコピーするのではなく、転記先のシート2の不要な行を非表示にするという形にしました。

Private Sub kanryou_Click()
Dim wrow As Long, LastRow As Long
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Set sh1 = Worksheets("予定表")
Set sh2 = Worksheets("完了分")
LastRow = sh2.Cells(Rows.Count, "B").End(xlUp).Row + 1
If LastRow < 3 Then LastRow = 3
For wrow = 8 To 307
If sh1.Cells(wrow, 21) = "完了" Then
sh1.Range("B" & wrow & ":AM" & wrow).Copy sh2.Range("B" & LastRow & ":AM" & LastRow)
LastRow = LastRow + 1
End If
Next wrow
End Sub

[abc-.-cba]

ご認識の通り関数式を残したいと思っております。
関数式はD,F,V~AI,AK,AM列に入っています。
転記された行には新しい予定を入れたいと思っていますので
シート1のD,F,V~AI,AK,AM列に入っている関数式を残したいです。

[abc-.-cba]

シート2へのコピーに関してはシート2の不要な列を非表示にするという形を取りましたので全てコピーのままで問題ありません。可能であればシート１の空白になっている行を上に繰り上げできれば嬉しいです。

[tatsu99]

シート１は切り取らないので、コピーした行の各セルを空白にします。
但し、関数式のあるD,F,V~AI,AK,AM列を除きます。
関数式のあるD,F,V~AI,AK,AM列は、他の列が空白になったとき、自動的に自身の列も空白になる関数が
埋め込んであるという前提で良いですか。

[tatsu99]

＞可能であればシート１の空白になっている行を上に繰り上げできれば嬉しいです。
こちらは、図で確認したいので回答欄に書きました。①②のどちらのケースを望んでますか。

[abc-.-cba]

わかりやすくご説明ありがとうございます。
②を想定していました。言葉足らずで申し訳ございません。

[abc-.-cba]

シート１は切り取らないので、コピーした行の各セルを空白にします。
但し、関数式のあるD,F,V~AI,AK,AM列を除きます。
関数式のあるD,F,V~AI,AK,AM列は、他の列が空白になったとき、自動的に自身の列も空白になる関数が
埋め込んであるという前提で良いですか。
＞はい。関数に関してはこちらで作成しますのでその前提でお願い致します。