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.