簡體   English   中英

根據多個條件將行從一張紙剪切/粘貼到另一張紙

[英]Cut/Paste Rows from one sheet to another based on multiple criteria

在此之后,我已經從另一個教學視頻中操作了代碼。 我似乎無法讓它正常工作,希望我能得到一些幫助。 我希望完成的是查看 Excel 文件中的單個列並剪切滿足要求的行並將其粘貼到另一個工作表上的第一個打開行。

Sub V_LTC()

Dim i As Long, LastRow As Long, LTCtype As String, erow As Long

LastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).row
Application.ScreenUpdating = False

For i = LastRow To 2 Step -1
LTCtype = Cells(i, "BX")

If (LTCtype = "UVT") Then                 ''''''''''''''''''''''''
ElseIf (LTCtype = "V2") Then              '
ElseIf (LTCtype = "V2A") Then             'Requirements For Sorting
ElseIf (LTCtype = "RMV2") Then            '
ElseIf (LTCtype = "RMVA") Then            ''''''''''''''''''''''''

ActiveCell.EntireRow.Cells(i, "BX").Select
Selection.Cut
erow = Sheet7.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).row
ActiveSheet.Paste Destination:=Worksheets("V-LTC").Rows(erow)

End If

Next i

delete_blank_rows

End Sub

Sub delete_blank_rows()

Dim row As Long

LastRow = ThisWorkbook.Sheets("LTC and Transfer").Cells(Rows.Count, 
1).End(xlUp).row

row = 2
For row = row To LastRow
If Cells(row, 1) = "" Then
Cells(row, 1).EntireRow.Delete
End If
Next row

End Sub

If語句是錯誤的,但還有很多地方可以改進,尤其是依賴活動表的東西。 我認為這就是你所需要的:

Sub V_LTC()
  On Error GoTo Cleanup
  Application.ScreenUpdating = False: Application.EnableEvents = False
  Dim i As Long

  With ThisWorkbook.Sheets("LTC and Transfer")
    For i = .Cells(.Rows.count, "BX").End(xlUp).row To 2 Step -1
        Select Case .Cells(i, "BX").Value2
          Case "UVT", "V2", "V2A", "RMV2", "RMVA"
            .Rows(i).Copy Worksheets("V-LTC").Cells(.Rows.count, 1).End(xlUp).Offset(1)
            .Rows(i).Delete
        End Select
      Next i
  End With
Cleanup:
  Application.ScreenUpdating = True: Application.EnableEvents = True
End Sub

暫無
暫無

聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.

 
粵ICP備18138465號  © 2020-2024 STACKOOM.COM