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

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

由于您的三列大小不同，因此最安全的做法是一一复制。任何快捷方式 à la 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 很大，这段代码会很慢。我的直觉是，您正试图以一种低效的方式解决问题……当问题不断变化时，很难确定最佳策略。

Answer 2

看看粘贴特殊功能。有一个“跳过空白”属性可以帮助您。

Answer 3

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

这是一个优秀示例的链接，其中包含针对初学者的注释注释...

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