Copy a range of cells and only select cells with data

Question

I\'m looking for a way to copy a range of cells, but to only copy the cells that contain a value.

In my excel sheet I have data running from A1-A18, B is empty and C

Answer 1

Since your three columns have different sizes, the safest thing to do is to copy them one by one. Any shortcuts à la PasteSpecial will probably end up causing you headaches.

With Range("A1")
    Range(.Cells(1, 1), .End(xlDown)).Copy myDestinationRangeA
End With

With Range("B1")
    ' Column B may be empty. If so, xlDown will return cell C65536
    ' and whole empty column will be copied... prevent this.
    If .Cells(1, 1).Value = "" Then
        'Nothing in this column.
        'Do nothing.
    Else
        Range(.Cells(1, 1), .End(xlDown)).Copy myDestinationRangeB
    EndIf
End With

With Range("C1")
    Range(.Cells(1, 1), .End(xlDown)).Copy myDestinationRangeC
End With

Now this is ugly, and a cleaner option would be to loop through the columns, especially if you have many columns and you're pasting them to adjacent columns in the same order.

Sub CopyStuff()

    Dim iCol As Long

    ' Loop through columns
    For iCol = 1 To 3 ' or however many columns you have
        With Worksheets("Sheet1").Columns(iCol)
            ' Check that column is not empty.
            If .Cells(1, 1).Value = "" Then
                'Nothing in this column.
                'Do nothing.
            Else
                ' Copy the column to the destination
                Range(.Cells(1, 1), .End(xlDown)).Copy _
                    Destination:=Worksheets("Sheet2").Columns(iCol).Cells(1, 1)
            End If
        End With
    Next iCol

End Sub

---

EDIT So you've changed your question... Try looping through the individual cells, checking if the current cell is empty, and if not copy it. Haven't tested this, but you get the idea:

    iMaxRow = 5000 ' or whatever the max is. 
    'Don't make too large because this will slow down your code.

    ' Loop through columns and rows
    For iCol = 1 To 3 ' or however many columns you have
        For iRow = 1 To iMaxRow 

        With Worksheets("Sheet1").Cells(iRow,iCol)
            ' Check that cell is not empty.
            If .Value = "" Then
                'Nothing in this cell.
                'Do nothing.
            Else
                ' Copy the cell to the destination
                .Copy Destination:=Worksheets("Sheet2").cells(iRow,iCol)
            End If
        End With

        Next iRow
    Next iCol

This code will be really slow if iMaxRow is large. My hunch is that you're trying to solve a problem in a sort of inefficient way... It's a bit hard to settle on an optimal strategy when the question keeps changing.

Answer 2

Take a look at the paste Special function. There's a 'skip blank' property that may help you.

Answer 3

To improve upon Jean-Francois Corbett's answer, use .UsedRange.Rows.Count to get the last used row. This will give you a fairly accurate range and it will not stop at the first blank cell.

Here is a link to an excellent example with commented notes for beginners...

• Excel macro - paste only non empty cells from one sheet to another - Stack Overflow