粘贴到新工作表后，从源删除整行

这段代码中的所有东西都运行良好，直到我需要删除源选项卡（“状态报告”）的“I”列中的行。 我必须多次运行此macros以清除所有要删除的行，因为它似乎一次只删除一行。

我怎样才能得到这个macros删除所有我想要的行，只运行一次这个代码？

Sub CopyYes() Dim c As Range Dim j As Integer Dim Source As Worksheet Dim Target As Worksheet ' Change worksheet designations as needed Set Source = ActiveWorkbook.Worksheets("Status Report") Set Target = ActiveWorkbook.Worksheets("Sheet1") j = 1 ' Start copying to row 1 in target sheet For Each c In Source.Range("I1:I1000") ' Do 1000 rows If c = 1 Then Source.Rows(c.Row).Copy Target.Rows(j) j = j + 1 Source.Rows(c.Row).EntireRow.Delete End If Next c 

结束小组

谢谢你的帮助！

Answer 1

这怎么样？ 它，如@yass所示，从最后一行开始，向后。

 Sub CopyYes() Dim c As Range Dim j As Integer Dim Source As Worksheet Dim Target As Worksheet Dim lastRow As Long ' Change worksheet designations as needed Set Source = ActiveWorkbook.Worksheets("Status Report") Set Target = ActiveWorkbook.Worksheets("Sheet1") blankRow = Target.Cells(Target.Rows.Count, 1).End(xlUp).Row ' Start copying to row 1 in target sheet lastRow = 1000 ' lastRow = Source.Cells(Source.Rows.Count, 9).End(xlUp).Row ' Uncomment this line if you want to do ALL rows in column I With Source For i = lastRow To 1 Step -1 If .Cells(i, 9).Value = 1 Then If blankRow = 1 Then .Rows(i).Copy Target.Rows(blankRow) Else .Rows(i).Copy Target.Rows(blankRow + 1) End If blankRow = Target.Cells(Target.Rows.Count, 1).End(xlUp).Row .Rows(i).EntireRow.Delete Next i End With End Sub 

注意：主要区别是For循环。 AFAIK你不能For each x in Range循环中的For each x in Range向后。