复制一个单元格范围，只select数据单元格
我正在寻找一种方法来复制单元格范围，但只复制包含值的单元格。
在我的Excel表中，我有从A1-A18运行的数据，B是空的，C1-C2。 现在我想复制所有包含值的单元格。
With Range("A1") Range(.Cells(1, 1), .End(xlDown).Cells(50, 3)).Copy End With 这将复制从A1-C50的所有内容，但我只希望复制A1-A18和C1-C2，就好像这些包含数据一样。 但它需要以一种方式形成，一旦我有数据在B或我的范围扩展，这些也得到了复制。
'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
谢谢！
感谢Jean，现在的代码：
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包含数据，A6是白色，A7包含数据。 它停在A6，然后转到B列，并以同样的方式继续。
由于您的三栏大小不同，最安全的方法就是逐一复制。 PasteSpecial的任何快捷方式都可能最终导致您头痛。
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
现在这是丑陋的，一个更清洁的select将循环通过列，特别是如果你有很多列，并按照相同的顺序粘贴到相邻的列。
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
编辑所以你已经改变了你的问题…尝试循环通过单个单元格，检查当前单元格是否为空，如果不复制它。 没有testing过这个，但是你明白了：
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
如果iMaxRow很大，这个代码会很慢。 我的直觉是，你试图以一种低效率的方式来解决问题…当问题不断变化时，要解决一个最佳的策略是有点困难的。
看看粘贴特殊function。 有一个“空白”属性，可以帮助你。
要改善Jean-Francois Corbett的答案，请使用.UsedRange.Rows.Count获取上次使用的行。 这将给你一个相当准确的范围，它不会停在第一个空白单元格。
这里是一个链接到一个优秀的例子，初学者注释…
- Excelmacros – 只粘贴非空单元格到另一个 – 堆栈溢出