Excel expression to copy rows but remove blank row

问题:

I need to copy data from one worksheet into another. However, I need a conditional copy operation that will skip rows based on criteria.

For example, if I start with...

Active  Value
yes     1
no      2
no      3
yes     4
no      5
no      6

I only want to copy rows that are Active=yes, so I would end up with...

Value
1
4

Can someone show me how this is done with 1) a macro and 2) a formula?

回答1:

Formula approach:

suppose your data are in sheet1, range A2:B7.

Then use this formula in sheet2 cell A2:

=IFERROR(INDEX(Sheet1!B:B,SMALL(IF(Sheet1!$A$2:$A$7="yes",ROW(Sheet1!$A$2:$A$7)),ROW()-ROW($A$2)+1)),"")

with array entry (CTRL+SHIFT+ENTER) and then drag it down.

VBA approach:

You can use AutoFilter:

Sub test()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim rng As Range, rngToCopy As Range
    Dim lastrow As Long
    'change Sheet1 and Sheet2 to suit
    Set ws1 = ThisWorkbook.Worksheets("Sheet1")
    Set ws2 = ThisWorkbook.Worksheets("Sheet2")

    With ws1
        'assumung that your data stored in column A:B, Sheet1
        lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
        Set rng = .Range("A1:B" & lastrow)
        'clear all filters
        .AutoFilterMode = False
        With rng
            'apply filter
            .AutoFilter Field:=1, Criteria1:="yes"
            On Error Resume Next
            'get only visible rows
            Set rngToCopy = .SpecialCells(xlCellTypeVisible)
            On Error GoTo 0
        End With
        'copy range
        If Not rngToCopy Is Nothing Then rngToCopy.Copy Destination:=ws2.Range("A1")
        'clear all filters
        .AutoFilterMode = False
    End With
    Application.CutCopyMode = False
End Sub

Note, if you want to copy only Value column, change

Set rngToCopy = .SpecialCells(xlCellTypeVisible)

to

Set rngToCopy = .Offset(, 1).Resize(, .Columns.Count - 1).SpecialCells(xlCellTypeVisible)

回答2:

It's easy enough with a macro. Assuming you're copying from the first sheet to the second sheet, and that your sample above is in columns A and B, you could do the following:

Public Sub ConditionalCopy()

    Dim copyRng As Range
    Set copyRng = Worksheets(1).Range("B2:B7")

    Dim pasteRng As Range
    Set pasteRng = Worksheets(2).Range("A2")

    Dim i As Long
    i = 0

    For Each cell in copyRng.Cells
       If cell.Offset(0, -1).Value2 = "yes" Then
          pasteRng.Offset(i,0).Value2 = cell.Value2
          i = i + 1
       End If
    Next cell
End Sub

Doing it with a formula presents a challenge in terms of not leaving any blank rows on the second sheet. It would be pretty trivial to just use the following in the second sheet:

=If(A2 = "yes",b2,"")

And copy that down, but you're going to end up with blank rows that you'll have to go back and delete yourself. If you have the ability to use the macro, it's straightforward enough that I would go that route rather than sinking too much effort into devising a formula. The more I think about it, the more I feel like it has to be a programmatic solution to avoid double references.

回答3:

If you use seperate counters for the source and destination rows, and use cell references rather than ranges the following routine should do the trick

Public Sub copyactivevalue()

Dim i As Integer
Dim j As Integer
Dim acts As Excel.Worksheet
Dim news As Excel.Worksheet

Set acts = Excel.Worksheets("sheet1")
Set news = Excel.Worksheets("sheet2")


With acts
    j = 2
    For i = 2 To 7
        If acts.Cells(i, 1).Value = "yes" Then
            news.Cells(j, 1) = acts.Cells(i, 2).Value
            j = j + 1
        End If

    Next
End With

Set acts = Nothing
Set news = Nothing
End Sub

Hope this helps