Удаление целых строк из источника после вставки в новый лист

Все в этом коде работает хорошо до той части, где мне нужно удалить строки в столбце «I» исходной вкладки («Отчет о состоянии»). Мне нужно запустить этот макрос несколько раз, чтобы очистить все строки, которые я хочу удалить, потому что он удаляет только одну строку за раз.

Как я могу заставить этот макрос удалить все нужные мне строки и запустить этот код только один раз?

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

Конец сабвуфера

Спасибо за вашу помощь!


loops excel row
person Wendy    schedule 14.04.2017    source источник
comment
Лучше запустить Last Row up, чтобы удаление работало корректно   -  person yass    schedule 15.04.2017
comment
Большое спасибо за подсказку yass! Как бы я написал это в приведенном выше коде?   -  person Wendy    schedule 15.04.2017

Ответы (1)


arrow_upward
0
arrow_downward

Как это? Он, как предложил @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. Насколько я знаю, вы не можете выполнить цикл For each x in Range в обратном направлении.

person BruceWayne    schedule 15.04.2017
comment
Огромное спасибо за вашу помощь, BruceWayne :) Я добавил End If прямо перед Next i, и это сработало как волшебство! - person Wendy; 15.04.2017
comment
@Венди - Ах, черт возьми! Я забыл это сделать, но отредактировал. Рад, что это сработало! - person BruceWayne; 15.04.2017
comment
Еще один вопрос, если можно. Как изменить j, чтобы данные начинали копироваться после последней строки данных? Спасибо еще раз! - person Wendy; 15.04.2017
comment
@ Венди, что ты имеешь в виду? Вы хотите изменить j на ...? Вы хотите, чтобы скопированный диапазон (на целевом листе) находился в том же порядке, что и исходный? - person BruceWayne; 15.04.2017
comment
Я хочу, чтобы данные, копируемые на целевой лист, начинали вставлять целые строки в первую пустую строку (я бы использовал 1-й столбец на целевом листе, чтобы определить, куда вставить). Это имеет смысл? - person Wendy; 15.04.2017
comment
@ Венди - Ах, да. Смотрите редактирование. Это то, что вы имели в виду? - person BruceWayne; 15.04.2017