Run-Time 1004: Copy method of range class failed

[forbin2002]

Hello All!
Let me start by thanking everyone that posts here. I'm a VBA beginner and I've been able to learn so much by writing my code then making it work by looking through this forum. Thanks!

Thank being said I've run into an issue that I haven't been able to find a resolution to so I figured I'd post.

Long story short I have a "RawData" sheet that has data for multiple locations on and I'm using an autofilter to copy each locations data to a new sheet. (A method I've modified from post by Jbeaucaire, Thanks!) Everything works great until the 17th sheet when I get a "RunTime 1004: Copy method of range class failed" error message. If I debug and activate the sheet in question the data is there! If I then start the code it'll make it through the loop one more time then error out with the same message and If I debug again and select the next sheet the data is there as well. I can then start the code and it will complete....sometimes... other times I just keep getting the Run-Time 1004 error.

The closest thing I can find to an answer is this Support Article from Microsoft. http://support.microsoft.com/kb/210684/en-us
Which describes having to save, close and then reopen the workbook when attempting to copy the same worksheet multiple times. As this isn't what I'm doing I don't think this is my issue but it's the closest thing I can find.

Does anyone know if there is some kind of limitation regard coping cells from one sheet to multiple sheets. Or is there an error in my code that I'm missing? What is so frustrating to me is that it works for the first 16 iterations of the loop then bombs out on the final two.

Here the code that is causing me issues.

Public Sub FacilityArray()
Dim ThisBook As Workbook
Dim RawData As Worksheet
Dim Lookups As Worksheet
Dim FinalRow As Long
Dim Count As Long
Dim TabCount As Long
Dim FacArray As Variant
Dim ACount As Long

Set ThisBook = ThisWorkbook
Set RawData = ThisBook.Sheets("RawData")
Set Lookups = ThisBook.Sheets("lookups")
FinalRow = RawData.Cells(Rows.Count, 1).End(xlUp).Row
RawData.Columns(26).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Lookups.Range("R1"), Unique:=True
'Add TabNames to Array
FacArray = Application.WorksheetFunction.Transpose(Lookups.Range("R2:R" & Rows.Count).SpecialCells(xlCellTypeConstants))
Sheets("Summary").Activate
ACount = UBound(FacArray)
For TabCount = 1 To UBound(FacArray)
'This creates the Facility sheets
Application.ScreenUpdating = False
If Not Evaluate("=ISREF('" & FacArray(TabCount) & "'!A1)") Then
Sheets.Add(After:=Worksheets(Worksheets.Count)).Name = FacArray(TabCount)
Else
Sheets(FacArray(TabCount)).Move After:=Sheets(Sheets.Count)
End If

Application.ScreenUpdating = True
Next
'This will parse the data to each facilites sheet
TabCount = 1
For Count = 1 To UBound(FacArray)
With RawData
.Activate
.AutoFilterMode = False
.Cells(1, 1).Select
'This will copy the defects per location
Selection.AutoFilter Field:=26, Criteria1:=FacArray(TabCount)
.Columns("A:AD").SpecialCells(xlCellTypeVisible).Copy Destination:=Sheets(FacArray(TabCount)).Range("A35")

TabCount = TabCount + 1
End With
Next

With RawData
.Activate
.AutoFilterMode = False
End With
Sheets("Summary").Activate

Set ThisBook = Nothing
Set RawData = Nothing
Set Lookups = Nothing

End Sub

Thanks for taking the time, any suggestions would be greatly appreciated.

 

[AlphaFrog]

It's not obvious to me what the problem is in your code.

I cleaned up somethings below. Sometimes just doing it differently can cure whatever problem there was (or it creates a whole new set of problems).

Public Sub FacilityArray()

    Dim RawData As Worksheet
    Dim FacSheet As Worksheet
    Dim rngFacs As Range
    Dim Fac As Range
    Dim FinalRow As Long
    
    Set RawData = ThisWorkbook.Sheets("RawData")
    FinalRow = RawData.Cells(Rows.Count, "Z").End(xlUp).Row
    
    RawData.Columns("Z").AdvancedFilter Action:=xlFilterInPlace, Unique:=True
    Set rngFacs = RawData.Range("Z2:Z" & FinalRow).SpecialCells(xlCellTypeVisible)      'TabNames
    If RawData.FilterMode Then RawData.ShowAllData
    
    Application.ScreenUpdating = False
    
    For Each Fac In rngFacs
    
        'This creates the Facility sheets
        Set FacSheet = Nothing
        On Error Resume Next
            Set FacSheet = Sheets(Fac.Value)
        On Error GoTo 0
        If FacSheet Is Nothing Then
            Sheets.Add(After:=Sheets(Sheets.Count)).Name = Fac.Value
            Set FacSheet = ActiveSheet
        Else
            FacSheet.Move After:=Sheets(Sheets.Count)
        End If

        'This will parse the data to each facilites sheet
        With RawData
            .AutoFilterMode = False
            'This will copy the defects per location
            .Range("A1:AD" & FinalRow).AutoFilter Field:=26, Criteria1:=Fac.Value
            .Range("A1:AD" & FinalRow).SpecialCells(xlCellTypeVisible).Copy Destination:=FacSheet.Range("A35")
        End With
        
    Next Fac
    
    Application.ScreenUpdating = True
    
    RawData.AutoFilterMode = False
    Sheets("Summary").Activate
    
    Set RawData = Nothing
    
End Sub