Help on VBA - Runtime error

[tonyjyoo]

I have a macro for 4 workbooks. All are exactly the same. However, one of the workbooks gives me a run-time error message, as well as sometimes giving me a range of error message.

Here is my code:

Sub UpdateEmployeeAllocationList()


'Automatically update Employee Allocation List with 2 latest files to account for terminations.


Dim Main As Workbook
Dim Month As Workbook


'Optimization
    Application.ScreenUpdating = False


R = "B4:L2000"
R1 = "A3:K1000"


Range(R).Clear


Set Main = ThisWorkbook
file = Range("A1").Value
Set Month = Workbooks.Open("S:\NPH Accounting\NPH Accounting Department\Allocations\2016\Employee Allocation\" & file & " Employee Allocations 2016.xlsx")


'the below is the workbook where the data will be copied from it is getting activated
Month.Activate
Month.Sheets("Employee Allocation List").Select
'now when the above workbook is activated the data from its active sheet will be selected and copied
Month.Sheets("Employee Allocation List").Range(R1).Select
Application.CutCopyMode = False
Selection.Copy
'now the sheet where you are running this macro from is being activated
Main.Activate
'Now you will select and change focus to the sheet where you want to copy your data
Main.Sheets("Employee Allocation List").Activate
Range("B4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False


Application.CutCopyMode = False


'Determine which month data is from.


    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent1
        .TintAndShade = 0.599993896298105
        .PatternTintAndShade = 0
    End With




Month.Close False


    Range("A4:L4").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 6299648
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    With Selection.Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
    
Columns("H:L").Select
    Selection.NumberFormat = "0.00%"




'Now for 2nd Employee Allocation List




R = "B4:L2000"
R1 = "A4:K1000"






Set Main = ThisWorkbook
file2 = Range("A2").Value
Set Month2 = Workbooks.Open("S:\NPH Accounting\NPH Accounting Department\Allocations\2016\Employee Allocation\" & file2 & " Employee Allocations 2016.xlsx")


'the below is the workbook where the data will be copied from it is getting activated
Month2.Activate
Month2.Sheets("Employee Allocation List").Select
'now when the above workbook is activated the data from its active sheet will be selected and copied
Month2.Sheets("Employee Allocation List").Range(R1).Select
Application.CutCopyMode = False
Selection.Copy
'now the sheet where you are running this macro from is being activated
Main.Activate
'Now you will select and change focus to the sheet where you want to copy your data
Main.Sheets("Employee Allocation List").Activate


Range("B1999").Select
Selection.End(xlUp).Select
    ActiveCell.Offset(1).Select


Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False


ActiveCell.Offset(1).Select
ActiveCell.Offset(-1).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    
    
Application.CutCopyMode = False




    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent2
        .TintAndShade = 0.599993896298105
        .PatternTintAndShade = 0
    End With


Month2.Close False


'Delete duplicates from employee allocation list




    ActiveSheet.Range("$A$4:$O$2000").AutoFilter Field:=15, Criteria1:= _
        "Duplicate"
    Range("A5:O2000").SpecialCells(xlCellTypeVisible).EntireRow.Delete
    ActiveSheet.Range("$A$4:$O$2000").AutoFilter Field:=15


'Add Formulated rows for next update


    Range("A5").Select
    Selection.Copy
    Range("A5:A2000").Select
    ActiveSheet.Paste
    
    Range("N5:O5").Select
    Selection.Copy
    Range("N5:O2000").Select
    ActiveSheet.Paste




Application.ScreenUpdating = True


 'To the Top!
    Application.Goto Reference:=Range("a1"), Scroll:=True


End Sub

I can't figure out why 3 of my workbooks work but the last one doesn't. Can someone please advise? Also, after the macro fails to run, I'm unable to click on anything. Workbook isn't protected. Seems corrupted.

 

[Kenneth Hobson]

Maybe you have protected cells you are trying to paste to?

You should add some error check to exit gracefully. Activate and Selection are seldom needed. e.g.

Sub Main()
  On Error GoTo EndSub
  
  Application.ScreenUpdating = False
  
  Range("N5:O5").Copy Range("N5:O2000")
  
EndSub:
  Application.ScreenUpdating = True
End Sub