Just an observation:
Application.WorksheetFunction.CountA(Range("A:A"))
will not return a true row count where there are already blank rows (eg because the macro has been run before). Try:
ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
or:
ActiveSheet.Range("A" & .Cells.SpecialCells(xlCellTypeLastCell).Row).End(xlUp).Row