Question

此代码中的所有内容都能正常工作，直到我需要删除列中的行＆＃34; I＆＃34;源选项卡（＆＃34;状态报告＆＃34;）。我必须多次运行这个宏来清除我要删除的所有行，因为它似乎一次只删除一行。

如何让这个宏删除我想要的所有行，只运行一次这段代码？

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

End Sub

感谢您的帮助！

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。

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

1 个答案: