Copiar archivos txt y abrir para buscar datos y copia en una celda

Buenas soy nuevo y me gustaría una ayuda.

quiero copiar tres archivos de una unidad a otra para trabajar con ellos. con un boton busco lo que pongo en la celda de la hoja1 en la celda a24 en un archivo de forma secuencial.

set fso=createobjetc("scripting.filesystemobject")

set archivo= Fso.CopyFile ("P:\mapperS.pv", "C:\gonzalez\temporal\MAPPERS.PV")

set archivo= Fso.CopyFile ("P:\ssv.pv", "C:\gonzalez\temporal\ssv.PV")

Dim ts As TextStream

Dim strCodigo As String

Dim strLinea As String

Set ts = Fso.OpenTextFile("C:\gonzalez\temporal\MAPPERS.PV")

strCodigo = ("a24" )

Do While Not (ts.AtEndOfStream)

strLinea = ts.ReadLine

If strCodigo = Left(strLinea, Len(strCodigo)) Then

SVALOR1 = Mid(strLinea, 1, 8)

SVALOR3 = Mid(strLinea, 19, 4)

SVALOR4 = Mid(strLinea, 61, 4)

SVALOR5 = Mid(strLinea, 23, 3)

SVALOR6 = Mid(strLinea, 42, 3)

SVALOR7 = Mid(strLinea, 31, 5)

SVALOR8 = Mid(strLinea, 38, 4)

SVALOR9 = Mid(strLinea, 301, 3)

SVALOR10 = Mid(strLinea, 985, 4)

SVALOR11 = Mid(strLinea, 528, 2)

SVALOR11A = Mid(strLinea, 530, 2)

SVALOR11B = Mid(strLinea, 532, 3)

SVALOR12 = Mid(strLinea, 536, 2)

SVALOR12A = Mid(strLinea, 538, 2)

SVALOR12B = Mid(strLinea, 540, 3)

SVALOR13 = Mid(strLinea, 543, 2)

SVALOR13A = Mid(strLinea, 545, 3)

SVALOR13B = Mid(strLinea, 548, 3)

SVALOR13C = Mid(strLinea, 551, 2)

sValor14 = Mid(strLinea, 240, 3)

SVALOR15 = Mid(strLinea, 243, 3)

SVALOR16 = Mid(strLinea, 553, 3)

sValor17 = Mid(strLinea, 1074, 20)

SVALOR18 = Mid(strLinea, 1002, 15)

SVALOR19 = Mid(strLinea, 225, 14)

svalor20 = Mid(strLinea, 391, 2)

SVALOR21 = Mid(strLinea, 352, 6)

SVALOR22 = Mid(strLinea, 358, 6)

svalor23 = Mid(strLinea, 1, 3)

Exit Do

Loop

a24b= SVALOR1

a24c = SVALOR3

a24d = SVALOR4

si me pueden echar una mano, no se como recolococar y terminar.