Run-time error '1004': Copy Method of Worksheet Class failed

[liamwhan]

Hi all,

I am working with a bulky HR Data report and am trying to automate a process where I extract certain data from the spreadsheet using auto filters and then copying the filtered data onto new worksheets.

Unfortunately, I'm a fairly amateur coder and I've more or less just recorded the process using Macro Record and then cleaned up the generated code as best I can.

When I run the Macro it works fine for a while and then eventually when it gets to a certain ActiveSheet.Paste command about halfway through, i get "Run-time error '1004': Copy Method of Worksheet Class Failed"

Some sites have suggested that this is an Excel error that requires a user to save, close and reopen the Workbook. So I attempted to write this process into the code.

In the middle of the Sub, before the error occurs I have inserted the following:
[VBA]
MName = ActiveSheet.Name & ".xls"
MDir = ActiveWorkbook.Path
ActiveWorkbook.SaveAs Filename:=MDir & "\" & MName
Application.ScreenUpdating = False
Application.OnTime Now, "Vacancy2"
ThisWorkbook.Close True
End Sub

Sub Vacancy2()
ThisWorkbook.Activate
Range("A1").Activate
Selection.AutoFilter Field:=34, Criteria1:="Permanent Full Time"[/VBA]

But when it reopens the workbook I get a different '1004' error: "Autofilter method of Range class failed"

Can anyone help! I can appreciate that my code probably isnt the most efficient way to achieve what I need to achieve so any suggestions anywhere would be greatly appreciated!

The full sub - without the save,close,reopen part is below.

[VBA]Sub Vacancy()
'
' Vacancy Macro
' Macro recorded 19/12/2011 by WHANL
'

'
Sheets.Add
Sheets.Add
Sheets.Add
Sheets("Sheet3").Select
Sheets("Sheet3").Name = "Pure Vacancies"
Sheets("Sheet2").Select
Sheets("Sheet2").Name = "HDA & Temp"
Sheets("Sheet1").Select
Sheets("Sheet1").Name = "Perm Filled"
Sheets(6).Activate
Rows("1:1").Select
Selection.AutoFilter
ActiveWindow.SmallScroll ToRight:=3
Columns("G:H").Select
Selection.Cut
Columns("AI:AI").Select
Selection.Insert Shift:=xlToRight
Columns("M:M").Select
Selection.Cut
Columns("AI:AI").Select
Selection.Insert Shift:=xlToRight
Columns("AF:AH").Select
Selection.Interior.ColorIndex = 37
Columns("AI:AK").Select
Selection.Interior.ColorIndex = 36
Selection.AutoFilter Field:=34, Criteria1:="Permanent Full Time"
Selection.AutoFilter Field:=37, Criteria1:="="
Cells.Select
Selection.Copy
Sheets("Pure Vacancies").Activate
ActiveSheet.Paste
Sheets(6).Activate
Selection.AutoFilter Field:=34, Criteria1:="Permanent Part Time"
Dim LR As Long, LC As Integer
LR = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
LC = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
Range(Cells(2, 1), Cells(LR, LC)).Select
Selection.Copy
Sheets("Pure Vacancies").Activate
Range("A1").End(xlDown).Offset(1, 0).Select
ActiveSheet.Paste
Sheets(6).Activate
Selection.AutoFilter Field:=34
Selection.AutoFilter Field:=37
Selection.AutoFilter Field:=34, Criteria1:="Permanent Full Time"
Selection.AutoFilter Field:=37, Criteria1:="Agency Temp"
Cells.Select
Selection.Copy
Sheets("HDA & Temp").Activate
ActiveSheet.Paste
Sheets(6).Activate
Selection.AutoFilter Field:=37, Criteria1:="Casual"
LR = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
LC = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
Range(Cells(2, 1), Cells(LR, LC)).Select
Selection.Copy
Sheets("HDA & Temp").Activate
Range("A1").End(xlDown).Offset(1, 0).Select
ActiveSheet.Paste
Sheets(6).Activate
Selection.AutoFilter Field:=37, Criteria1:="Contractor/Consult."
LR = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
LC = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
Range(Cells(2, 1), Cells(LR, LC)).Select
Selection.Copy
Sheets("HDA & Temp").Activate
Range("A1").End(xlDown).Offset(1, 0).Select
ActiveSheet.Paste
Sheets(6).Activate
Selection.AutoFilter Field:=37, Criteria1:="HDA Permanent Full Time"
LR = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
LC = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
Range(Cells(2, 1), Cells(LR, LC)).Select
Selection.Copy
Sheets("HDA & Temp").Activate
Range("A1").End(xlDown).Offset(1, 0).Select
ActiveSheet.Paste
Sheets(6).Activate

Selection.AutoFilter Field:=37, Criteria1:="HDA Permanent Part Time"
LR = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
LC = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
Range(Cells(2, 1), Cells(LR, LC)).Select
Sheets("HDA & Temp").Activate

Range("A1").End(xlDown).Offset(1, 0).Select
ActiveSheet.Paste
Sheets(6).Activate
Selection.AutoFilter Field:=37, Criteria1:="HDA Temporary Full Time"
LR = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
LC = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
Range(Cells(2, 1), Cells(LR, LC)).Select
Selection.Copy
Sheets("HDA & Temp").Activate
Range("A1").End(xlDown).Offset(1, 0).Select
ActiveSheet.Paste
Sheets(6).Activate
Selection.AutoFilter Field:=37, Criteria1:="Student Placement"
LR = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
LC = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
Range(Cells(2, 1), Cells(LR, LC)).Select
Selection.Copy
Sheets("HDA & Temp").Activate
Range("A1").End(xlDown).Offset(1, 0).Select
ActiveSheet.Paste
Sheets(6).Activate
Selection.AutoFilter Field:=37, Criteria1:="Temporary Full Time"
LR = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
LC = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
Range(Cells(2, 1), Cells(LR, LC)).Select
Selection.Copy
Sheets("HDA & Temp").Activate
Range("A1").End(xlDown).Offset(1, 0).Select
ActiveSheet.Paste
Sheets(6).Activate
Selection.AutoFilter Field:=37, Criteria1:="Temporary Part Time"
LR = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
LC = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
Range(Cells(2, 1), Cells(LR, LC)).Select
Selection.Copy
Sheets("HDA & Temp").Activate
Range("A1").End(xlDown).Offset(1, 0).Select
ActiveSheet.Paste
Sheets(6).Activate
Selection.AutoFilter Field:=37
Selection.AutoFilter Field:=34, Criteria1:="Permanent Part Time"
Selection.AutoFilter Field:=37, Criteria1:="Casual"
LR = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
LC = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
Range(Cells(2, 1), Cells(LR, LC)).Select
Selection.Copy
Sheets("HDA & Temp").Activate
Range("A1").End(xlDown).Offset(1, 0).Select
ActiveSheet.Paste
Range("A266").Select
Sheets(6).Activate
Selection.AutoFilter Field:=37, Criteria1:="HDA Permanent Full Time"
LR = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
LC = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
Range(Cells(2, 1), Cells(LR, LC)).Select
Selection.Copy
Sheets("HDA & Temp").Activate
Range("A1").End(xlDown).Offset(1, 0).Select
ActiveSheet.Paste
Sheets(6).Activate
Selection.AutoFilter Field:=37, Criteria1:="HDA Permanent Part Time"
LR = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
LC = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
Range(Cells(2, 1), Cells(LR, LC)).Select
Selection.Copy
Sheets("HDA & Temp").Activate
Range("A1").End(xlDown).Offset(1, 0).Select
ActiveSheet.Paste
Sheets(6).Activate
Selection.AutoFilter Field:=37, Criteria1:="HDA Temporary Full Time"
LR = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
LC = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
Range(Cells(2, 1), Cells(LR, LC)).Select
Selection.Copy
Sheets("HDA & Temp").Activate
Range("A1").End(xlDown).Offset(1, 0).Select
ActiveSheet.Paste
Sheets(6).Activate
Selection.AutoFilter Field:=37, Criteria1:="Temporary Full Time"
LR = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
LC = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
Range(Cells(2, 1), Cells(LR, LC)).Select
Selection.Copy
Sheets("HDA & Temp").Activate
Range("A1").End(xlDown).Offset(1, 0).Select
ActiveSheet.Paste
Sheets(6).Activate
Selection.AutoFilter Field:=37, Criteria1:="Temporary Part Time"
LR = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
LC = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
Range(Cells(2, 1), Cells(LR, LC)).Select
Selection.Copy
Sheets("HDA & Temp").Activate
Range("A1").End(xlDown).Offset(1, 0).Select
ActiveSheet.Paste
Sheets(6).Activate
Selection.AutoFilter Field:=34, Criteria1:="Permanent Full Time"
Selection.AutoFilter Field:=37, Criteria1:="Permanent Full Time"
Cells.Select
Selection.Copy
Sheets("Perm Filled").Activate
ActiveSheet.Paste
Sheets(6).Activate
Selection.AutoFilter Field:=37, Criteria1:="Permanent Part Time"
LR = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
LC = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
Range(Cells(2, 1), Cells(LR, LC)).Select
Selection.Copy
Sheets("Perm Filled").Activate
Range("A1").End(xlDown).Offset(1, 0).Select
ActiveSheet.Paste
Sheets(6).Activate
Selection.AutoFilter Field:=37
Selection.AutoFilter Field:=34, Criteria1:="Permanent Part Time"
Selection.AutoFilter Field:=37, Criteria1:="Permanent Full Time"
LR = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
LC = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
Range(Cells(2, 1), Cells(LR, LC)).Select
Selection.Copy
Sheets("Perm Filled").Activate
Range("A1").End(xlDown).Offset(1, 0).Select
ActiveSheet.Paste
Sheets(6).Activate
Selection.AutoFilter Field:=37, Criteria1:="Permanent Part Time"
LR = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
LC = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
Range(Cells(2, 1), Cells(LR, LC)).Select
Selection.Copy
Sheets("Perm Filled").Activate
Range("A1").End(xlDown).Offset(1, 0).Select
ActiveSheet.Paste
Sheets(6).Activate
Sheets("HDA & Temp").Activate
ActiveSheet.ShowAllData
Sheets("Pure Vacancies").Activate
ActiveSheet.ShowAllData
Sheets("Perm Filled").Activate
ActiveSheet.ShowAllData
Sheets("HDA & Temp").Activate
ActiveCell.Value = "Perm Filled?"
With ActiveCell.Characters(Start:=1, Length:=4).Font
.Name = "Microsoft Sans Serif"
.FontStyle = "Bold"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
ActiveWorkbook.Save
Range("BV2").Select
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(RC[-42],'Perm Filled'!C[-42]:C[-37],6,FALSE)"
Selection.AutoFill Destination:=Range("BV2:BV5000")
Rows("1:1").Select
Range("BD1").Activate
Selection.AutoFilter
Selection.AutoFilter
Selection.AutoFilter Field:=74, Criteria1:="#N/A"
LR = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
LC = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
Range(Cells(2, 1), Cells(LR, LC)).Select
Selection.Copy
Sheets("Pure Vacancies").Activate
Range("A1").End(xlDown).Offset(1, 0).Select
ActiveSheet.Paste
End Sub



[/VBA]

[macropod]

Hi Liam,

The routine might fail is if there are no data to copy & paste. You can avoid that by testing the # of filtered rows before copying & pasting.

Your code could also be made much more efficient and reliable by:
• not using selections
• not activating sheets to work on them
• specifying worksheets by name/reference rather than by index.

Here's some Untested) code showing how your's might be improved. Note that I've left the reference to Sheets(6) in there as I don't know it's name - you should replace the '6' with the actual name in double quotes (eg "Data Sheet"). The first line in the sub should be un-commented once your development testing has concluded - the code will run much faster then.
[vba]Sub Vacancy()
'Application.ScreenUpdating = False
Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet
Dim LR As Long, LC As Long
With ThisWorkbook
Set ws1 = .Sheets.Add
Set ws2 = .Sheets.Add
Set ws3 = .Sheets.Add
ws3.Name = "Pure Vacancies"
ws2.Name = "HDA & Temp"
ws1.Name = "Perm Filled"
With .Sheets(6)
.Rows("1:1").AutoFilter
.Columns("G:H").Cut
.Columns("AI:AI").Insert Shift:=xlToRight
.Columns("M:M").Cut
.Columns("AI:AI").Insert Shift:=xlToRight
.Columns("AF:AH").Interior.ColorIndex = 37
.Columns("AI:AK").Interior.ColorIndex = 36
.Rows("1:1").Copy
ws3.Paste
ws2.Paste
ws1.Paste
.AutoFilterMode = False
.AutoFilter Field:=34, Criteria1:="Permanent Full Time"
.AutoFilter Field:=37, Criteria1:="="
LR = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
LC = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
If LR > 1 Then
.Range(Cells(2, 1), Cells(LR, LC)).Copy
ws3.Range("A1").End(xlDown).Offset(1, 0).Paste
End If
.AutoFilterMode = False
.AutoFilter Field:=34, Criteria1:="Permanent Part Time"
LR = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
LC = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
If LR > 1 Then
.Range(Cells(2, 1), Cells(LR, LC)).Copy
ws3.Range("A1").End(xlDown).Offset(1, 0).Paste
End If
.AutoFilterMode = False
.AutoFilter Field:=34, Criteria1:="Permanent Full Time"
.AutoFilter Field:=37, Criteria1:="Agency Temp"
If LR > 1 Then
.Range(Cells(2, 1), Cells(LR, LC)).Copy
ws2.Range("A1").End(xlDown).Offset(1, 0).Paste
End If
.AutoFilterMode = False
.AutoFilter Field:=37, Criteria1:="Casual"
LR = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
LC = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
If LR > 1 Then
.Range(Cells(2, 1), Cells(LR, LC)).Copy
ws2.Range("A1").End(xlDown).Offset(1, 0).Paste
End If
' Remaining rows for filtering, copying & pasting, optimised as above
End With
'Balance of code, optimised
Set ws1 = Nothing: Set ws2 = Nothing: Set ws3 = Nothing
Application.ScreenUpdating = True
End Sub[/vba]

[Bob Phillips]

Don't forget to dot qualify the [A1] such as in After:=[A1] (better still, don't use that horrible [A1] notation).