Copy a range of cells and only select cells with data

问题:

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 C1-C2. Now I would like to copy all the cells that contain a value.

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

This will copy everything from A1-C50, but I only want A1-A18 and C1-C2 to be copied seen as though these contain data. But it needs to be formed in a way that once I have data in B or my range extends, that these get copied too.

'So the range could be 5000 and it only selects the data with a value. With Range("A1") Range(.Cells(1, 1), .End(xlDown).Cells(5000, 3)).Copy End With

Thanks!

---

Thanks to Jean, Current code:

Sub test()  Dim i As Integer Sheets("Sheet1").Select i = 1  With Range("A1")    If .Cells(1, 1).Value = "" Then    Else      Range(.Cells(1, 1), .End(xlDown)).Copy Destination:=Sheets("Sheet2").Range("A" & i)      x = x + 1    End If End With  Sheets("Sheet1").Select  x = 1 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 Destination:=Sheets("Sheet2").Range("B" & i)        x = x + 1     End If End With  Sheets("Sheet1").Select  x = 1 With Range("C1")     If .Cells(1, 1).Value = "" Then     Else         Range(.Cells(1, 1), .End(xlDown)).Copy Destination:=Sheets("Sheet2").Range("C" & i)         x = x + 1     End If End With  End Sub

A1 - A5 contains data, A6 is blanc, A7 contains data. It stops at A6 and heads over to column B, and continues in the same way.

回答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.

回答2:

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

回答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

转载请标明出处:Copy a range of cells and only select cells with data

文章来源: Copy a range of cells and only select cells with data