Recorrer Celdas de Columna y Copiar Excel

Estimados Expertos:
Tengo el siguiente código VB que copia el contenido de la Celda A1 de la Hoja1 y la pega en la Celda A1 de la Hoja2, y después exporta el rango A1:A100 de la Hoja2 a un fichero txt.
Hasta aquí todo bien, pero necesito que este proceso se repita con todas las celdas de la Hoja1, con un rango de A1:A500, con lo cual tendría que tener exportados 500 archivos txt.
Actualmente este código solo copia la celda A1 de la Hoja1, y se para, y necesito que continúe, hasta que llegue al A500.

Ej:

Copiar A1 de hoja 1 ---> pegar en A1 de hoja 2
Exportar rango de hoja 2, A1:A100 a un fichero txt
Copiar A2 de hoja 1 ---> pegar en A1 de hoja 2
Exportar rango de hoja 2, A1:A100 a un fichero txt
Copiar A3 de hoja 1 ---> pegar en A1 de hoja 2
Exportar rango de hoja 2, A1:A100 a un fichero txt
Copiar A4 de hoja 1 ---> pegar en A1 de hoja 2
Exportar rango de hoja 2, A1:A100 a un fichero txt

-
Gracias de antemano por su ayuda.

Código:

Sub EXPORTAR()
Range("A1").Select
Selection.Copy
Sheets("A2").Select
Range("A1").Select
ActiveSheet.Paste
'exporta un rango de celdas
Dim FileSysObj As Object
Dim ArchivoTxt As Object
Dim AreaTexto
nombre = Format(Now, "ddmmyy-hhmmss")
AreaTexto = ActiveSheet.Range("A1:A100").Value
Set FileSysObj = CreateObject("Scripting.FileSystemobject")
Set ArchivoTxt = FileSysObj.CreateTextFile("C:\EXCEL\" & nombre & ".txt", True)
'recorre el rango a copiar
Dim celda
For Each celda In AreaTexto
ArchivoTxt.WriteLine celda
Next
ArchivoTxt.Close
End Sub