How to arrange cells like this?

[Admin]

replace

Set r = Range("A1", Range("A1").End(xlDown).Offset(1))

with

Set r = Range("A1", Range("A" & Rows.Count).End(xlUp).Offset(1))