Merging worksheets and using find/replace
To supplement Gaffi's suggestions, I think you would benefit from changing this:

'Char mishap replacements
With Workbooks("CompanyBook.xlsm")
.Worksheets("Report1").Cells.Replace What:="&amp;quot;", Replacement:=Chr(34), LookAt:=xlPart, MatchCase:=False
.Worksheets("Report2").Cells.Replace What:="â€™", Replacement:="’", LookAt:=xlPart, MatchCase:=False
.Worksheets("Report2").Cells.Replace What:="â€¦", Replacement:="…", LookAt:=xlPart, MatchCase:=False
.Worksheets("Report2").Cells.Replace What:="Â£", Replacement:="£", LookAt:=xlPart, MatchCase:=False
'.Worksheets("Report2").Cells.Replace What:="â€˜", Replacement:="‘L", LookAt:=xlPart, MatchCase:=False
.Worksheets("Company").Select
End With


To this:

Dim r1 As Excel.Range, r2 As Excel.Range
Set r1 = Workbooks("CompanyBook.xlsm").Worksheets("Report1").Cells.SpecialCells(xlCellTypeConstants)
Set r2 = Workbooks("CompanyBook.xlsm").Worksheets("Report2").Cells.SpecialCells(xlCellTypeConstants)

With r1
    .Replace What:="&amp;amp;", Replacement:="&amp;", LookAt:=xlPart, MatchCase:=False
    .Replace What:="&amp;quot;", Replacement:=Chr(34), LookAt:=xlPart, MatchCase:=False
End With

With r2
    .Replace What:="â€¦", Replacement:="…", LookAt:=xlPart, MatchCase:=False
    .Replace What:="Â£", Replacement:="£", LookAt:=xlPart, MatchCase:=False
End With


This way, you narrow down the selection to only cells that have content for Excel to find/replace. Also, because you set the range to a variable once, Excel doesn't have to search through all cells multiple times like it is now.