Hola! Como estan? Les comento que estoy teniendo un leve problema con una macro que por suerte ya casi termino. La misma funciona de la siguiente manera.
Tengo una macro en un archivo de excel la cual se ejecuta automaticamente al abrir el mismo.
Lo que hace en si la macro es ala autoejecutarse empieza a buscar en todos los archivos que nosotros le decimos que busque cierta palabra, Una vez que encuentra la misma, Lo va copiando en un archivo nuevo el cual se llama consolidado.
Mi problema con el codigo es el siguiente, La macro me devuleve solamente la palabra a buscar y lo que pasa es que la palabra que yo le doy a buscar es un ambiente, es decir una tabla dinamica, con lo cual necesito que no me copie la palabra que encuentra sino que cuando encuentra la misma que copie el valor de esa celda al archivo consolidado, sin embargo no me esta saliendo....
Asimismo y esta siendo realmente una cosa facil necesito que me busque esa palabra en todo el archivo y no se como ponerlo en codigo, Soy nueva en esto y me trabo en ciertas cosas.
Les dejo el codigo que hice hasta el momento.
Sub Auto_Open()
FrmCopiarPrimerHoja.Show
End Sub
Sub copiar_datos(ByVal archivo_origen_ruta As String, ByVal archivo_destino As String)
'copia los Datos Proveedor y Subtotal
Dim archivo_origen As String, RsBusq As Range, ROFO As String, Subtotal, fila As Long
archivo_origen = Dir(archivo_origen_ruta)
With Workbooks(archivo_origen)
.Activate
With .Sheets(1)
.Activate
Set RsBusq = .Columns("C:C").Find(what:="ROFO JAN 2013", lookat:=xlWhole, LookIn:=xlValues)
If Not RsBusq Is Nothing Then
ROFO = RsBusq.Offset(0, 0).Value
Else
Lista_Errores = Lista_Errores & vbNewLine & "-No se pudo encontrar el nombre del " _
& "ROFO en el archivo " & archivo_origen_ruta
ROFO = ""
End If
End With
End With
If ROFO <> "" Then
'se escriben los valores en la hoja resumen
With Workbooks(archivo_destino)
.Activate
With Sheets(1)
fila = .Cells(Rows.Count, "A").End(xlUp).Row + 1
If .Cells(Rows.Count, "C").End(xlUp).Row + 1 > fila Then fila = .Cells(Rows.Count, "C").End(xlUp).Row + 1
.Cells(fila, "A").Value = ROFO
.Cells(fila, "D").Value = archivo_origen_ruta
End With
End With
End If
Set RsBusq = Nothing
End Sub
espero que me puedan dar una mano.
Gracias por adelantado!
Saludos!!!!
ENFAN
Camila Rodriguez Cassa
Featured Replies
Archivado
Este tema está ahora archivado y está cerrado a más respuestas.
Hola! Como estan? Les comento que estoy teniendo un leve problema con una macro que por suerte ya casi termino. La misma funciona de la siguiente manera.
Tengo una macro en un archivo de excel la cual se ejecuta automaticamente al abrir el mismo.
Lo que hace en si la macro es ala autoejecutarse empieza a buscar en todos los archivos que nosotros le decimos que busque cierta palabra, Una vez que encuentra la misma, Lo va copiando en un archivo nuevo el cual se llama consolidado.
Mi problema con el codigo es el siguiente, La macro me devuleve solamente la palabra a buscar y lo que pasa es que la palabra que yo le doy a buscar es un ambiente, es decir una tabla dinamica, con lo cual necesito que no me copie la palabra que encuentra sino que cuando encuentra la misma que copie el valor de esa celda al archivo consolidado, sin embargo no me esta saliendo....
Asimismo y esta siendo realmente una cosa facil necesito que me busque esa palabra en todo el archivo y no se como ponerlo en codigo, Soy nueva en esto y me trabo en ciertas cosas.
Les dejo el codigo que hice hasta el momento.
Sub Auto_Open()
FrmCopiarPrimerHoja.Show
End Sub
Sub copiar_datos(ByVal archivo_origen_ruta As String, ByVal archivo_destino As String)
'copia los Datos Proveedor y Subtotal
Dim archivo_origen As String, RsBusq As Range, ROFO As String, Subtotal, fila As Long
archivo_origen = Dir(archivo_origen_ruta)
With Workbooks(archivo_origen)
.Activate
With .Sheets(1)
.Activate
Set RsBusq = .Columns("C:C").Find(what:="ROFO JAN 2013", lookat:=xlWhole, LookIn:=xlValues)
If Not RsBusq Is Nothing Then
ROFO = RsBusq.Offset(0, 0).Value
Else
Lista_Errores = Lista_Errores & vbNewLine & "-No se pudo encontrar el nombre del " _
& "ROFO en el archivo " & archivo_origen_ruta
ROFO = ""
End If
End With
End With
If ROFO <> "" Then
'se escriben los valores en la hoja resumen
With Workbooks(archivo_destino)
.Activate
With Sheets(1)
fila = .Cells(Rows.Count, "A").End(xlUp).Row + 1
If .Cells(Rows.Count, "C").End(xlUp).Row + 1 > fila Then fila = .Cells(Rows.Count, "C").End(xlUp).Row + 1
.Cells(fila, "A").Value = ROFO
.Cells(fila, "D").Value = archivo_origen_ruta
End With
End With
End If
Set RsBusq = Nothing
End Sub
espero que me puedan dar una mano.
Gracias por adelantado!
Saludos!!!!
ENFAN
Camila Rodriguez Cassa