GetOpenFile para copiar información de un libro a otro con respecto al valor de una celda.

Tengo una macro, para un templete de Excel en el cual por medio de un "GetOpenFilename" se abre un explorador de windows para seleccionar un determinado archivo de excel, la macro busca (en el archivo abierto por el getopen) en la fila 1 la celda con el valor "LINE TAG" y copia toda la información de la columna, para después en el archivo templete (previamente abierto) buscar en la fila 1, la misma celda con valor "LINE TAG" (esta celda no se encuentra en la misma intentar de columna que en el archivo abierto) y pegar esta información. Lo interesante es que los archivos de donde se extrae la información son periódicos, llegan cada semana y tienen nombres diferentes por eso la selección con el getopenfilename y la información se tiene que pegar, en el archivo templete, en la siguiente celda vacía que encuentre de la columna donde esta la información de la celda LINE TAG. La macro es la siguiente:

Sub CopiarLineTag()

Dim rutaArchivo As String
rutaArchivo = Application.GetOpenFilename("Excel files (*.xlsx),*.xlsx")

If rutaArchivo = "False" Then Exit Sub

Workbooks.Open rutaArchivo

Dim lineaTagColumna As Long
lineaTagColumna = 0
For i = 1 To Columns.Count
If Cells(1, i).Value = "LINE TAG" Then
lineaTagColumna = i
Exit For
End If
Next i

If lineaTagColumna = 0 Then
MsgBox "No se encontró 'LINE TAG' en la fila 1 del archivo seleccionado."
Workbooks(rutaArchivo).Close SaveChanges:=False
Exit Sub
End If

Dim ultimaFila As Long
ultimaFila = Cells(Rows.Count, lineaTagColumna).End(xlUp).Row
Range(Cells(2, lineaTagColumna), Cells(ultimaFila, lineaTagColumna)).Copy

Workbooks(rutaArchivo).Open

lineaTagColumna = 0
For i = 1 To Columns.Count
If Cells(1, i).Value = "LINE TAG" Then
lineaTagColumna = i
Exit For
End If
Next i

If lineaTagColumna = 0 Then
MsgBox "No se encontró 'LINE TAG' en la fila 1 del archivo seleccionado."
Workbooks(rutaArchivo).Close SaveChanges:=False
Exit Sub
End If

Cells(2, lineaTagColumna).PasteSpecial xlPasteValues

Workbooks(rutaArchivo).Close SaveChanges:=True

End Sub

Sin embargo la macro me marca un detalle en la línea "Workbooks(rutaArchivo).Open" y no realiza el copiado de información.

1 Respuesta

Respuesta
2

Leyendo tu código observo que ya está abierto el libro luego de la instrucción GetOpen...

Workbooks. Open rutaArchivo

Por lo tanto no es necesaria esa instrucción (Workbooks(rutaArchivo). Open), que además está mal escrita. El libro ya está abierto y es el libro activo.

Debieras revisar si estás copiando-pegando correctamente. Lo ideal es que guardes el nombre del libro en una variable, antes de abrir el segundo. Si necesitas ayuda para esto, comentame qué deseas copiar y de dónde a dónde.

Y ya que hablamos de copiar/pegar te invito a mirar mi último video Nª 71

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas