VBA-行を別のシートに移動して、新しいシートにある順序を並べ替えます。

Question

Excelブックには、メイントラッキング、進行中、完了、および削除の4つのタブがあります。メイントラッキングシートには、何百ものタスクのリストがあります。列A〜Gは各タスクに関する情報を保持し、列「H」はタスクの現在の状態を示すドロップダウンリストを保持する。考え方は、列「H」のドロップダウンをクリックしてステータスを調整できることです。「進行中」が選択されている場合、その行のタスクは「進行中」タブに移動されます。

しかし、私が実行している問題は「進行中」シート内にあり、「メイントラッキング」シートにない追加の入力用の列があります。私はまた、各シートの右側の最後の列として "ステータス"列を保持したいと思います。本質的には、「A：G」列から「In Progress」タブの対応する「A：G」列にデータをドロップしますが、ステータス列（列「H」）は3つの追加の右側に移動します列（この場合、列「K」）。誰もこれを行う方法を知っていますか？

私はこれが長い巻頭の質問であることを知っていますが、どんな助けでも大歓迎です。ありがとう！

以下

異なるセルにデータを移動するための私のコードです：

Option Explicit 

Sub MoveRows() 
    Application.ScreenUpdating = False 

    With Worksheets("Main Tracking") 
     With .Range("H1", .Cells(.Rows.Count, "H").End(xlUp)) 
      FilterAndCopy .Cells, "In Progress" 
      FilterAndCopy .Cells, "Completed" 
      FilterAndCopy .Cells, "Remove" 
     End With 
    End With 

    Application.ScreenUpdating = True 
End Sub 

Sub FilterAndCopy(rng As Range, filterStrng As String) 
    With rng 
     .AutoFilter Field:=1, Criteria1:=filterStrng 
     If Application.WorksheetFunction.Subtotal(103, .Resize(, 1)) > 1 Then 
      With .Resize(.Rows.Count).Offset(1).SpecialCells(xlCellTypeVisible).EntireRow 
      .Copy Destination:=Worksheets(filterStrng).Cells(Rows.Count, "A").End(xlUp).Offset(1) 
      .Delete 
      End With 
     End If 
     .Parent.AutoFilterMode = False 
    End With 
End Sub 

Answer 1

これは、インプレースフィルタ処理の範囲での作業ペーストした後、最後の列を移動するので、簡単にトリッキーだ...

Sub FilterAndCopy(rng As Range, filterStrng As String) 
    Dim shtDest As Worksheet, rngDest As Range 
    Set shtDest = Worksheets(filterStrng) 
    Set rngDest = shtDest.Cells(Rows.Count, "A").End(xlUp).Offset(1) 
    With rng 
     .AutoFilter Field:=1, Criteria1:=filterStrng 
     If Application.WorksheetFunction.Subtotal(103, .Resize(, 1)) > 1 Then 
      With .Resize(.Rows.Count).Offset(1).SpecialCells(xlCellTypeVisible).EntireRow 
      .Copy Destination:=rngDest 
      .Delete 
      End With 
      With shtDest.Range(rngDest, shtDest.Cells(.Rows.Count, 1).End(xlUp)).Offset(0, 7) 
       .Cut Destination:=.Offset(0, 3) 
      End With 
     End If 
     .Parent.AutoFilterMode = False 
    End With 
End Sub