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

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

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

Answer 2

看看粘贴特殊功能。有一个'跳空白'属性可以帮助你。

Answer 3

要改进Jean-Francois Corbett的答案，请使用.UsedRange.Rows.Count来获取最后使用的行。这将为您提供相当准确的范围，并且不会停留在第一个空白区域。

这是一个很好的例子的链接，为初学者注释了注释......

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

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

3 个答案: