基於列值移動行

Question

我需要掃描「主」工作表中的所有行，在「狀態」列中找到值爲「發貨」的單元格，然後剪切並粘貼每行到另一行片。粘貼的行也需要放在最後一行之後。

我找到了this後（粘貼在下面），我稍作修改，以成功刪除行。但我不知道如何移動行。我應該嘗試一種全新的方法嗎？

Sub DeleteRows() 

    Dim rng As Range 
    Dim counter As Long, numRows as long   

     With ActiveSheet 
      Set rng = Application.Intersect(.UsedRange, .Range("C:C")) 
     End With 
     numRows = rng.Rows.Count 

     For counter = numRows to 1 Step -1 
     If Not rng.Cells(counter) Like "AA*" Then 
      rng.Cells(counter).EntireRow.Delete 
     End If 
     Next 

End Sub 

我不知道VBA。由於我簡短的編程歷史，我只能理解它。我希望這樣可以，並且感謝您的幫助。

Answer 1

我最後結合我最初使用的代碼（found here）一個AutoFilter宏（found here）。這可能不是最有效的方式，但它現在起作用。如果有人知道我只能使用For循環或者只使用AutoFilter方法，那就太好了。這是我的代碼。我應該做的任何修改？

Sub DeleteShipped() 

Dim lastrow As Long 
Dim rng As Range 
Dim counter As Long, numRows As Long 

    With Sheets("Master") 

     'Check for any rows with shipped 
     If .Range("R:R").Find("Shipped", , xlValues, xlWhole, , , False) Is Nothing Then 
      MsgBox "No shipped plates found. ", , "No Rows Moved": Exit Sub 
     Else 

      Application.ScreenUpdating = False 

      'Copy and paste rows 
      lastrow = .Range("A" & Rows.Count).End(xlUp).Row 
      lastrow2 = Worksheets("ShippedBackup").Cells(Rows.Count, "A").End(xlUp).Row + 1 
      .Range("A1:U" & lastrow).AutoFilter field:=18, Criteria1:="Shipped" 
      .Range("A2:U" & lastrow).SpecialCells(xlCellTypeVisible).EntireRow.Copy 
      Sheets("ShippedBackup").Range("A" & lastrow2).PasteSpecial xlPasteValues, xlPasteSpecialOperationNone, False, False 
      .ShowAllData 

      'Delete rows with shipped status 
      Set rng = Application.Intersect(.UsedRange, .Range("R:R")) 
      numRows = rng.Rows.Count 

      For counter = numRows To 1 Step -1 
      If rng.Cells(counter) Like "Shipped" Then 
       rng.Cells(counter).EntireRow.Delete 
      End If 
      Next 

      MsgBox "All shipped records have been moved to the ""ShippedBackup"" worksheet.", , "Backup Complete" 

     End If 
End With 

希望它可以幫助別人！

Answer 2

有幾種方法你可以做到這一點，你可以添加一個過濾器到頂部的列，過濾'發貨'的價值？是否需要複製並粘貼到新表中？

它不是最簡潔的代碼，但它可能工作

sub Shipped_filter() 
dim wsSheet as worksheet 
dim wsOutputSheet as worksheet 
dim BottomRow as integer 

Set wsSheet = worksheets("Sheet1") 'change to the sheet name 
set wsOutputSheet = worksheets("Sheet2") 'change to the sheet name 

'***************************** 
'* Delete old data on Sheet2 * 
'***************************** 
wsoutputsheet.activate 
Activesheet.cells.clearall 

wsSheet.range("A1").select 
selection.autofilter 

BottomRow = wsSheet.range("A90000").end(xlup).row ' or another column you guarantee will always have a value 

activesheet.range("$A$1:$Z$"&BottomRow).AutoFilter field:=1, Criteria1:="Shipped" ' change field to whatever column number Status is in 

'******************************** 
'* Error trap in case no update * 
'******************************** 

if activesheet.range("A90000").end(xlup).row = 1 then 
msgbox("Nothing to ship") 
exit sub 
end if 


wsSheet.range("A1:Z"&Bottomrow).select 
selection.copy 

wsOutputSheet.range("A1").select 
selection.pastespecial Paste:=xlpastevalues 
application.cutcopymode = false 

msgbox('update complete') 

end sub 

我還沒有嘗試過，所以可能需要更新