[已解决]请高手看看这个1004的错误，即“类RANG的COPY方法无效是什么原因（EXCEL用的是2003版

jxsazjf008

具体的代码如下：
Dim r As Range, fs As FileSearch
Dim x, y As Excel.Worksheet
Dim z As Integer
    Set myexcel = Excel.Application
    Set fs = Application.FileSearch
    Set x = ThisWorkbook.Sheets("sheet1")
    Set y = ThisWorkbook.Sheets("sheet2")
    With fs
        .LookIn = ThisWorkbook.Path & "\运行文件夹"
        .Filename = "*.xls"
        If .Execute > 0 Then
            Application.ScreenUpdating = False
            For i = 1 To .FoundFiles.Count
                Workbooks.Open .FoundFiles(i)
                Rows("1:1").Select
                myexcel.Selection.AutoFilter
                myexcel.Selection.AutoFilter Field:=2, Criteria1:="="
                Set r = ActiveSheet.AutoFilter.Range.SpecialCells(12)
                r.Select
                myexcel.Selection.Copy y.Cells(1, 1)
                z = y.Range("a65536").End(xlUp).Row
                x.Cells(i, 1).Value = z - 2
                y.Cells.Clear
                ActiveWorkbook.Close False
            Next i
            MsgBox "There were " & .FoundFiles.Count & " file(s) found."
        Else
            MsgBox "There were no files found."
        End If
    End With
End Sub

逐条运行后，在这句”myexcel.Selection.Copy y.Cells(1, 1)“上出了问题，系统报错：1004，类”RANG“的COPY方法无效”，但我看了一下代码表格中的SHEET2已经被COPY过去了具体的内容，到底是什么原因导致了代码运行不下去了，我查了一下宝典，解释了1004的错误是一种全捕获的错误，是EXCEL本身及相关对象的定义错误，但具体情况却未再做详细解释，到底是什么原因，请各位高手予以解答，万分感谢，悬赏分不多，仅是什么意思，还望各位海涵！！！另附件已上传

最佳答案

月排行榜 / 总排行榜

吕?布

2011-8-19 15:02

Sub Macro4()
'
' Macro4 Macro
' 宏由 User 录制，时间: 2011-8-2
'
    Dim iAreas As Long, iRow As Long
   
    Dim myexcel As Excel.Application
    Dim r As Range, fs As FileSearch
    Dim x, y As Excel.Worksheet
    Dim z As Integer
    Set myexcel = Excel.Application
    Set fs = Application.FileSearch
    Set x = ThisWorkbook.Sheets("sheet1")
    Set y = ThisWorkbook.Sheets("sheet2")
    With fs
        .LookIn = ThisWorkbook.Path & "\运行文件夹"
        .Filename = "*.xls"
        If .Execute > 0 Then
            Application.ScreenUpdating = False
            For i = 1 To .FoundFiles.Count
                Workbooks.Open .FoundFiles(i)
                Rows("1:1").Select
                myexcel.Selection.AutoFilter
                myexcel.Selection.AutoFilter Field:=2, Criteria1:="="
                Set r = ActiveSheet.AutoFilter.Range.SpecialCells(12)
                'r.Select
                'myexcel.Selection.Copy y.Cells(1, 1)
               
                ' 因为筛选后复制的区域不连续，粘贴时是粘贴不上的。要一个一个的粘贴
                iRow = 1
                For iAreas = 1 To r.Areas.Count
                    r.Areas(iAreas).Copy y.Cells(iRow, 1)
                    iRow = iRow + r.Areas(iAreas).Rows.Count
                Next iAreas
               
                z = y.Range("a65536").End(xlUp).Row
                x.Cells(i, 1).Value = z - 2
                y.Cells.Clear
                ActiveWorkbook.Close False
            Next i
            MsgBox "There were " & .FoundFiles.Count & " file(s) found."
        Else
            MsgBox "There were no files found."
        End If
    End With
End Sub

跳转到最佳答案楼层

吕?布

Sub Macro4()
'
' Macro4 Macro
' 宏由 User 录制，时间: 2011-8-2
'
    Dim iAreas As Long, iRow As Long
   
    Dim myexcel As Excel.Application
    Dim r As Range, fs As FileSearch
    Dim x, y As Excel.Worksheet
    Dim z As Integer
    Set myexcel = Excel.Application
    Set fs = Application.FileSearch
    Set x = ThisWorkbook.Sheets("sheet1")
    Set y = ThisWorkbook.Sheets("sheet2")
    With fs
        .LookIn = ThisWorkbook.Path & "\运行文件夹"
        .Filename = "*.xls"
        If .Execute > 0 Then
            Application.ScreenUpdating = False
            For i = 1 To .FoundFiles.Count
                Workbooks.Open .FoundFiles(i)
                Rows("1:1").Select
                myexcel.Selection.AutoFilter
                myexcel.Selection.AutoFilter Field:=2, Criteria1:="="
                Set r = ActiveSheet.AutoFilter.Range.SpecialCells(12)
                'r.Select
                'myexcel.Selection.Copy y.Cells(1, 1)
               
                ' 因为筛选后复制的区域不连续，粘贴时是粘贴不上的。要一个一个的粘贴
                iRow = 1
                For iAreas = 1 To r.Areas.Count
                    r.Areas(iAreas).Copy y.Cells(iRow, 1)
                    iRow = iRow + r.Areas(iAreas).Rows.Count
                Next iAreas
               
                z = y.Range("a65536").End(xlUp).Row
                x.Cells(i, 1).Value = z - 2
                y.Cells.Clear
                ActiveWorkbook.Close False
            Next i
            MsgBox "There were " & .FoundFiles.Count & " file(s) found."
        Else
            MsgBox "There were no files found."
        End If
    End With
End Sub

Select

帮顶的人      

adders

It might be caused by the whole row selection line: Rows("1:1").Select

instead, you may want to change above to:
range(cells(1,1),cells(1,cells(1,columns.count).end(xltoLeft).column)).select

Microsoft Refrence: support.microsoft.com/kb/905164

jxsazjf008

看了楼上的回复，我好象有点明白了，这是EXCEL本身自带的一个错误，只能采用别的方式，但问题是我想得到筛选的结果，即正常我们进行了自动筛选后，EXCEL会告诉我选出了多少条纪录，我现在就是想得出这个多少条的信息，既然COPY的方法无效，那么该用哪一种方法，我知道要以用分类汇总的方式，但问题是我带的表已经是分类汇总的形式了，请高手们能够予以赐教，万分感激！！！！！！！！！！！！！！！！

jxsazjf008

果然是高手，受益非浅