Question

我正在尝试复制列中的所有非空白记录并将其粘贴到某处。

下面的代码运行正常，直到我遇到只有一条记录的情况，它会复制整个列（A2到A1048576）。因此，当它尝试将值粘贴到新区域时，由于没有足够的行，我遇到了错误。

有人可以帮忙吗？我不希望看到超过2000条记录，我认为这里真正的问题只是当我只有一条记录并且我想要复制该记录而不是整列时的情况。

Sheets("FinalListofContracts").Select
Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy

Answer 1

在将选择扩展到全范围之前，我们可以测试整个范围是否超过2000行。或者更确切地说，我们只有在计数少于2000行时才能选择范围。完整代码：

Sheets("FinalListofContracts").Select
Range("A2").Select
If Range(Selection, Selection.End(xlDown)).Rows.Count < 2000 Then
    Range(Selection, Selection.End(xlDown)).Select
End If
Selection.Copy

显然，你可以使2000更大......在2000年之间的任何地方（如果这总是你的最大值）和65000（如果使用旧文件格式）应该给出所需的结果。

Answer 2

我认为最好将最后一行计算为no并给出复制工作表的范围。这是一个返回行数的函数，只需根据返回的行数进行复制。

Function RowCounter(sSheetName As String, sRangeCol As String) As Long
   Dim rowCnt As Long
    rowCnt = 0
    Sheets(sSheetName).Select
    rowCnt = ActiveSheet.Cells(Rows.Count, Range(sRangeCol).Column).End(xlUp).Row
    RowCounter = rowCnt
End Function

Sub copyRow()
    Dim aRange As String
     rowCnt = RowCounter("FinalListofContracts", "A1")
     aRange = "A1:A" & rowCnt     
     ActiveWorkbook.Sheets("FinalListofContracts").Range(aRange).copy

End Sub

选择并复制一系列单元格

2 个答案: