复制一系列单元格,仅选择包含数据的单元格

Question

我正在寻找一种复制一系列单元格的方法,但只复制包含值的单元格.

在我的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列,并以相同的方式继续.

Answer 1

由于您的三列具有不同的大小,最安全的做法是逐个复制它们."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

现在这很丑陋,更清晰的选择是遍历列,特别是如果你有很多列并且你以相同的顺序将它们粘贴到相邻的列.

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

编辑所以你已经改变了你的问题...尝试循环遍历各个单元格,检查当前单元格是否为空,如果没有复制它.没有测试过这个,但你明白了:

    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很大,这段代码会很慢.我的预感是,你试图以一种低效的方式解决问题......当问题不断变化时,有点难以找到最佳策略.