根据几个不同的标准从一张纸切割/粘贴行

时间:2017-05-26 18:46:40

标签: excel vba

在此之后我已经从另一个教学视频中操纵了代码。我似乎无法让它正常工作,希望我能得到一些帮助。我希望完成的是查看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

1 个答案:

答案 0 :(得分:0)

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