Question

 Do While ColumnCount <= lastColumn
    If Not IsEmpty(mailSheet.Cells(2, ColumnCount)) Then
        lastRow = mailSheet.Cells(Rows.Count, ColumnCount).End(xlUp).Row
        Set rng1 = mailSheet.Range(mailSheet.Cells(1, ColumnCount), mailSheet.Cells(lastRow, ColumnCount))



        If rng Is Nothing Then

            Set rng = rng1
        Else
            Set rng = Union(rng, rng1)
        End If


    End If
    ColumnCount = ColumnCount + 1
Loop

rng.Copy
Worksheets("Sheet1").PasteSpecial xlPasteValues

您好，我有一张包含45列的工作表，所有工作表都有标题。在这些列中，~5在标题下面有2或3个值。

我上面的代码创建了一个不连续的范围（变量＆＃34; rng＆＃34;）。我想找出一种方法来创建一个＆＃34;连续范围＆＃34;

我认为使用pastespecial命令会起作用，如其他stackoverflow问题所示（链接：Copying a discontinuous range from one sheet to another）。但是，就我而言，代码不会超出

rng.Copy

行，并返回错误：此命令不能用于多个部分

最后，我想给RNG发邮件，我已经有了一个模块。但是，它需要是连续的，所以我要么想办法重新格式化copy / pasteSpecial，要么我创建一个新的范围。

非常感谢任何提示！

Answer 1

最好的方法是使用Range.CurrentRegion。如果A1是第一个单元格，则转到立即窗口并键入

?Range("A1").CurrentRegion.Address

并查看是否能为您提供所需的范围。如果你有一些东西与你想要的东西相邻，那么CurrentRegion会太大了。在这种情况下，找到行数最多的列，并使用它来确定连续范围有多少行。

Sub CopyRange()

    Dim i As Long
    Dim lMax As Long

    'I assume you're setting this yourself
    Const ColumnCount As Long = 3

    'Loop through the columns and find the longest one
    For i = 1 To ColumnCount
        If Sheet1.Cells(Sheet1.Rows.Count, i).End(xlUp).Row > lMax Then
            lMax = Sheet1.Cells(Sheet1.Rows.Count, i).End(xlUp).Row
        End If
    Next i

    'If starting cell is A1, resize and copy
    Sheet1.Cells(1, 1).Resize(lMax, ColumnCount).Copy

    'paste somewhere
    Sheet1.Cells(10, 10).PasteSpecial xlValues

End Sub

复制不连续范围时，此命令不能用于多个部分

1 个答案: