如何复制范围并省略空白单元格?

时间:2013-12-16 03:15:32

标签: excel vba excel-vba

在表1的A栏中,我需要复制3000个单元格,每个单元格需要350个单元格。我当前的宏正在复制一切,直到我结束并复制空白。有没有办法在我的宏中包含“单元格空白无效”代码?

对不起,如果这听起来没有受过教育,我只是开始学习宏。 这是当前宏的副本,宏的其余部分与此相同,只是增加了350个。

Sub Copy_Bins_1_350()
    If Range("D12").Value <> "!" Then
        Exit Sub
    ElseIf Range("D12").Value = "!" Then
        Sheets("sheet1").Select
        Range("B2:B351").Select
        Selection.Copy
        Range("B2").Select
        Sheets("sheet2").Select
        Range("E12").Select
        With Selection.Font
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
        End With
    End If
End Sub

1 个答案:

答案 0 :(得分:0)

您可以使用Union形成自己的非空单元格范围,然后复制它们。

另外INTERESTING READ

尝试此操作(已完成测试

Sub Sample()
    Dim wsI As Worksheet, wsO As Worksheet
    Dim aCell As Range, rngCopyFrom As Range, rng As Range
    Dim lRow As Long

    Set wsI = ThisWorkbook.Sheets("BIN LIST PASTE")
    Set wsO = ThisWorkbook.Sheets("BIN LIST COPY")

    Set rng = wsI.Range("B2:B351")

    For Each aCell In rng
        If Len(Trim(aCell.Value)) <> 0 Then
            If rngCopyFrom Is Nothing Then
                Set rngCopyFrom = aCell
            Else
                Set rngCopyFrom = Union(rngCopyFrom, aCell)
            End If
        End If
    Next

    If Not rngCopyFrom Is Nothing Then _
    rngCopyFrom.Copy wsO.Range("E12")

    With wsO
        lRow = .Range("E" & .Rows.Count).End(xlUp).Row

        Set rng = .Range("E12:E" & lRow)

        With rng.Font
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
        End With
    End With
End Sub