Ошибка выполнения 6 – Переполнение, переменная, заданная как Long

У меня возникла проблема с копированием + вставка для фильтрованных данных. Мой код не сталкивается с ошибкой, если в фильтрованном поле будет результат 0 или> 1. Однако, если после фильтра появляется 1 запись, появляется ошибка Runtime 6. См. Код, используемый ниже:

Dim wsDue As Worksheet Dim wsTarget As Worksheet Dim y As Long Dim x As Long x = Range("A65536").End(xlUp).Row Range("A1").AutoFilter Field:=2, Criteria1:=Array("Yes"), Operator:=xlFilterValues Set wsDue = Worksheets("Due") Set wsTarget = Worksheets("Target List Consolidated") y = wsDue.Range("B" & wsDue.Rows.Count).End(xlUp).Row If wsDue.Range(wsDue.Cells(2, 2), wsDue.Cells(y, 2)).SpecialCells(xlCellTypeVisible).Count > 1 Then wsDue.Range("B2:B" & x).Copy wsTarget.Range("A65536").End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False Else: End If 

Прежде всего, убедитесь, что ваш Excel (aka MS-Office) имеет все применимые пакеты обновления. Проблема с одной отфильтрованной строкой, интерпретируемой как все строки, была известной ошибкой, но она была исправлена ​​в последующих пакетах обновлений.

Вы также можете применить код «лучшей практики», чтобы избежать его вообще. Свойство Range.CurrentRegion можно использовать для локализации метода Range.AutoFilter . Использовать прогрессивную С … End С заявлениями для дальнейшей изоляции передаваемых данных.

 Dim wsDue As Worksheet, wsTarget As Worksheet With Worksheets("Due") If .AutoFilterMode Then .AutoFilterMode = False 'work on the contiguous block of cells radiating out from A1 With .Cells(1, 1).CurrentRegion 'apply the AutoFilter .AutoFilter Field:=2, Criteria1:=Array("Yes"), Operator:=xlFilterValues 'shift one row down (off the header row) and resize one less row 'isolate column B With .Offset(1, 1).Resize(.Rows.Count - 1, 1) 'non-destructive test to see if there are any rows visible If CBool(Application.Subtotal(103, .Cells)) Then Set wsTarget = Worksheets("Target List Consolidated") .Copy wsTarget.Range("A65536").End(xlUp).Offset(1).PasteSpecial _ Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False End If End With End With End With 

Я решил еще один способ работать как решение. Вместо этого я использовал следующий код:

 Dim x As Long Dim wsDue As Worksheet Dim wsTarget As Worksheet x = Range("A65536").End(xlUp).Row Range("A1").AutoFilter Field:=2, Criteria1:=Array("Yes"), Operator:=xlFilterValues Set wsDue = Worksheets("Due") Set wsTarget = Worksheets("Target List Consolidated") If wsDue.Range("B1:B" & x).Offset(1, 0).SpecialCells(xlCellTypeVisible).Count > 1 Then wsDue.Range("B1:B" & x).Offset(1, 0).SpecialCells(xlCellTypeVisible).Copy wsTarget.Range("A65536").End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False Application.CutCopyMode = False Application.DisplayAlerts = False Else: End If 

Решение смогло получить результат фильтра и скопировать желаемый диапазон, исключая заголовок в строке 1.

  • Ошибка при запуске функции для преобразования координат в градусах в десятичную для EXCEL VBA
  • VBA: копирование всех данных на другой лист книги
  • Ошибка времени выполнения VBA 1004 Метод AutoFilter класса Range Failed
  • Аргумент VBA не является необязательной ошибкой userfrom listbox
  • VBA - vlookup работает с ошибкой времени выполнения '13'
  • Excel создает новый документ Word с использованием шаблона: ошибка во время выполнения 5981. Метод «Добавить» объекта «Документы» не удалось
  • Код ошибки Excel 1004 - метод открытия рабочих книг объекта не выполнен
  • Создание листов в двух разных книгах и ихменование после списка в этой книге
  • Ошибка 1004: ошибка, определяемая приложением или объект-ошибка. Excel
  • Ошибка «Подстрока вне диапазона» при попытке изменить цвет текста на основе значений ячеек
  • Excel VBA «Переполнение» Ошибка при установке Range.Value
  • Давайте будем гением компьютера.