Question

我的代码中出现以下错误

运行时错误1004'范围类的复制方法失败'

代码的作用是允许用户单击打开txt框的命令按钮，并允许用户从文件目录中选择文件。

然后，第二段代码将遍历所选工作簿的F列并找到一个国家/地区，然后创建一个新工作表，并将该国家/地区的数据粘贴并粘贴到新工作表中，并为该国家/地区命名该工作表然后返回列F和其他国家的重复。如果工作表处于65,000或更低，则表格超过280,000行，而Macro运行完美但任何结束都可以

运行时错误1004'范围类的复制方法失败'

代码错误.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

运行时错误1004'范围类的复制方法失败'

0 个答案: