Блог

Я пытаюсь скопировать все непустые записи в столбец и вставить их куда-нибудь.

Приведенный ниже код работает нормально, пока у меня не возникнет ситуация, когда у меня есть только одна запись, и она скопирует весь столбец ( A2 в A1048576 ). Поэтому, когда он попытался вставить значения в новую область, у меня возникла ошибка, потому что строк недостаточно.

Может кто-нибудь, пожалуйста, помогите? Я не ожидаю увидеть более 2000 записей, я думаю, что настоящая проблема здесь заключается только в ситуации, когда у меня есть только одна запись, и я хотел скопировать эту запись, а не весь столбец.

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

Я думаю, что лучше посчитать последнюю строку 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" amp; rowCnt     
     ActiveWorkbook.Sheets("FinalListofContracts").Range(aRange).copy

End Sub
  

Прежде чем расширять выделение до полного диапазона, мы можем проверить, будет ли этот полный диапазон содержать более 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 (при использовании старого формата файла) должен дать желаемый результат.