Ayuda con la siguiente macro

Hola expertos espero que alguien pueda echarme una mano, tengo la siguiente macro de este foro que modifique pero me falta la ultima parte, lo que esta en negritas indica la parte que quiero modificar. En términos generales lo que hace es copiar y pegar información de varios archivos y dejarlos en uno solo. Lo que necesito es que los datos que vaya copiando los pegue en la columna contigua, es decir, copio los datos del primer archivo y los pego en la columna B (En la columna A viene la fecha), posteriormente los datos del archivo siguiente que los pegue en la Columna C y asi sucesivamente que vaya pegando los datos de cada archivo que va abriendo en la columna contigua, espero haber sido claro y me puedan ayudar

Sub acumular()
'
mio = ActiveWorkbook.Name
ruta = ActiveWorkbook.Path & "\"
Set fso = CreateObject("scripting.filesystemobject")
Set carpeta = fso.getfolder(ruta)
For Each archivo In carpeta.Files
If archivo = ruta & mio Then GoTo salto
If archivo = ruta & "~$" & mio Then Exit For
Workbooks.Open archivo
otro = ActiveWorkbook.Name
Sheets(2).Select
Range("A2").Select
mi_celda = ActiveCell.Address
fecha = ActiveCell.Value
celdaI = ActiveCell.Offset(0, 6).Address
ActiveCell.End(xlDown).Select
ActiveCell.Offset(0, 6).Select
Range(celdaI, ActiveCell).Select
Selection.Copy
Workbooks(mio).Activate
Sheets("TMAX").Range("A1").Select
ActiveCell.End(xlDown).Select
Range("A1", ActiveCell).Select
Selection.Find(What:=fecha, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
ActiveCell.Select
Do While ActiveCell.Value <> ""
If ActiveCell.Value = "" Then
Selection.PasteSpecial
End If
ActiveCell.Offset(0, 1).Select
Loop
Selection.PasteSpecial
salto:
Next
End Sub

Les agradezco de antemano

Añade tu respuesta

Haz clic para o