Ошибка времени выполнения 1004 'Метод копирования класса Range Failed'

Я получаю следующую ошибку в моем коде

Ошибка времени выполнения 1004 'Метод копирования класса Range Failed'

Что делает код, он позволяет пользователю щелкнуть по командной кнопке, которая открывает окно txt и позволяет пользователю выбирать файл из каталога файлов.

Затем вторая часть кода проходит через столбец F выбранной книги и находит страну, а затем создает новый лист и вставляет данные для этой страны в новый лист и называет этот лист для страны, затем возвращается в столбец F и повторяет для других стран. Лист МАССИВНЫЙ более 280 000 строк, если лист составляет 65 000 или меньше, Macro работает отлично, но что-то еще, и мы получаем

Ошибка времени выполнения 1004 'Метод копирования класса Range Failed'

Ошибки кода в .SpecialCells(xlCellTypeVisible).Copy ActiveSheet.Range("A1") 'copy data for country under header Может ли мой код быть изменен для размещения большого количества строк

 Sub Open_Workbook_Dialog() Dim my_FileName As Variant MsgBox "Pick your TOV file" '<--| txt box for prompt to pick a file my_FileName = Application.GetOpenFilename(FileFilter:="Excel Files,*.xl*;*.xm*") '<--| Opens the file window to allow selection If my_FileName <> False Then Workbooks.Open Filename:=my_FileName Call Filter '<--|Calls the Filter Code and executes End If End Sub Public Sub Filter() Dim rCountry As Range, helpCol As Range With Worksheets("CountryList") '<--| refer to data worksheet With .UsedRange Set helpCol = .Resize(1, 1).Offset(, .Columns.Count) '<--| get a "helper" column just at the right of used range, it'll be used to store unique country names in End With With .Range("A1:Q" & .Cells(.Rows.Count, 1).Row) '<--| refer to its columns "A:Q" from row 1 to last non empty row of column "A" .Columns(6).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=helpCol, Unique:=True '<-- call AdvancedFilter on 6th column of the referenced range and store its unique values in "helper" column Set helpCol = Range(helpCol.Offset(1), helpCol.End(xlDown)) '<--| set range with unique names in (skip header row) For Each rCountry In helpCol '<--| iterate over unique country names range (skip header row) .AutoFilter 6, rCountry.Value2 '<--| filter data on country field (6th column) with current unique country name If Application.WorksheetFunction.Subtotal(103, .Cells.Resize(, 1)) > 1 Then '<--| if any cell other than header ones has been filtered... Worksheets.Add Worksheets(Worksheets.Count) '<--... add new sheet ActiveSheet.Name = rCountry.Value2 '<--... rename it .SpecialCells(xlCellTypeVisible).Copy ActiveSheet.Range("A1") 'copy data for country under header End If Next End With .AutoFilterMode = False '<--| remove autofilter and show all rows back End With helpCol.Offset(-1).End(xlDown).Clear '<--| clear helper column (header included) End Sub 

Давайте будем гением компьютера.