liamwhan
12-18-2011, 09:13 PM
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:
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"
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.
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
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:
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"
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.
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