基于列值移动行

我需要扫描“主”工作表中的所有行，在“状态”列中找到值为“发货”的单元格，然后剪切并粘贴每行到另一行片。粘贴的行也需要放在最后一行之后。基于列值移动行

我找到了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。由于我简短的编程历史，我只能理解它。我希望这样可以，并且感谢您的帮助。

来源

2013-01-18 tehbrando

我最后结合我最初使用的代码（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

希望它可以帮助别人！

来源

2013-01-22 15:36:27 tehbrando

有几种方法你可以做到这一点，你可以添加一个过滤器到顶部的列，过滤'发货'的价值？是否需要复制并粘贴到新表中？

它不是最简洁的代码，但它可能工作

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

我还没有尝试过，所以可能需要更新

来源

2013-01-18 22:53:47 Maudise

是可以添加过滤器。如果可能的话，我宁愿剪切和粘贴，因为那样我就不必删除行了。我现在尝试一下代码并回报。谢谢！ – tehbrando

我遇到了三个单独的错误。感谢您，我现在了解了AutoFilter和我如何能够找到其他代码进行编辑。我会稍微张贴我的答案。它可能不是最好的哈哈 – tehbrando

基于列值移动行

回答

相关问题