Question

我正在寻找一个宏来复制一系列单元格，但只复制包含值的单元格，而只复制值而不是公式。

我的问题几乎就是这个问题：

Copy a range of cells and only select cells with data

我发现这个宏观的brilljant :)但它只是缺少我需要的东西:(

iMaxRow = 5000'或最大值。 '不要太大，因为这会降低你的代码速度。

' 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

我希望你们中的一些天才可以帮助我。最好的祝福。林檎

Answer 1

简单 - 只需编辑Else语句......

' 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
            Worksheets("Sheet2").cells(iRow,iCol).value = .value
        End If
    End With

    Next iRow
Next iCol

希望这就是你的意思....

Answer 2

将 Sheet1 列A:C的已用部分中的所有单元格复制为 Sheet2 作为您可以使用的值

无论如何复制时，空白单元格将为空白。

Sub Better()
Dim ws As Worksheet
Set ws = Sheets("Sheet1")
Set rng1 = ws.Range(ws.[a1], ws.Cells(Rows.Count, "A").End(xlUp))
Sheets("Sheet2").Range(rng1.Address).Value = rng1.Value
End Sub

复制一系列单元格，仅选择包含数据的单元格，而只选择值而不是公式

2 个答案: