excel - VBA从行X复制到第一个空白单元格

Question

我有一个每天更新的 Excel 电子表格。它根据更新的数据生成一个列表。假设它生成了当天需要完成特定任务的每个人的列表。该列表的长度每天都在变化。为了完成必要的输出，它使用“如果此行中的另一个单元格不是空白，请执行...”结构中的公式:
=IF(LEN(I4)=0),"",)
有时这个列表可能会很长。而不是要求用户过度滚动，我想提供一个“复制到剪贴板”按钮。然后用户将这些行粘贴到另一个应用程序中。让它复制一个固定长度的列表没有问题——比如说，只需将 M4 到 M500 复制到剪贴板就很容易了。但是假设今天，列表只到 M286，明天到 M117，依此类推。我只想复制那些填充的单元格，而不是后面的空白单元格。
这是我从谷歌拼凑出来的:

Private Sub CommandButton1_Click()
    Application.ScreenUpdating = False
    Dim xSheet As Worksheet
    firstBlankRow = Worksheets("Sheet1").Range("M4").End(xlDown).Row + 1

    MsgBox (unusedRow)
    Set xSheet = ActiveSheet
    xSheet.Range("M4:M" & firstBlankRow).Copy

    Application.ScreenUpdating = True
End Sub

这成功地找到了最后一个带有公式的单元格。不过，这并不是我想要的。我想要最后一个带有值的单元格，该值由公式生成。在这种特殊情况下，“具有值的最后一个单元格”将始终是“第一个空白单元格之前的单元格”。列表中不会有任何空白。那么，我接近了吗？如何让它找到具有值的最后一个单元格？谢谢你。

Answer 1

复制底部不包括空白的列

要排除列底部的空白(="" 或 ')，请使用 Find方法及其 LookIn自变量的参数设置为 xlValues .

请注意，如果工作表被过滤或存在隐藏的行或列，这将失败。

工作表模块，例如Sheet1

假设命令按钮位于要从中复制的工作表 (Me) 上。

Option Explicit

Private Sub CommandButton1_Click()
    CopyColumnNonBlanks Me.Range("M4")
End Sub

标准模块，例如Module1

或者，您可以将其放入带有第一个代码的工作表模块中(不推荐)。然后你需要用例如调用它

Sheet1.CopyColumnNonBlanks(ThisWorkbook.Worksheets("Sheet2").Range("A4"))

对于另一个工作表。

Option Explicit

Sub CopyColumnNonBlanks(ByVal FirstCell As Range)
    With FirstCell.Cells(1)
        Dim lCell As Range: Set lCell = .Resize(.Worksheet.Rows.Count _
            - .Row + 1).Find("*", , xlValues, , , xlPrevious)
        If lCell Is Nothing Then
            MsgBox "All cells in the column range are blank.", vbCritical
            Exit Sub
        End If
        .Resize(lCell.Row - .Row + 1).Copy
    End With
End Sub