Error copiado

enfan · el 17 de abril

Hola como estaN, Camila desde argentina y estoy terminando, Pero me quede trabada y no puedo sacarla a flote

El codigo es el siguiente

Set RsBusq = .Columns("A2:Z2").Find(what:="cocacola", lookat:=xlWhole, LookIn:=xlValues)

If Not RsBusq Is Nothing Then

ROFO = RsBusq.Offset(0, 1).Value

Necesito que encuentyre todas las palabras"cocacola...." y me copie sus respectivas columnas hacia la derecha, pero no me esta saliendo...

Agradezco su ayuda!

Antoni · el 18 de abril

Busca Find en la Ayuda de VBA y encontrarás un ejemplo de como hacer búsquedas con múltiples ocurrencias.

enfan · el 18 de abril

Muchas Grcias por tu respuesta Macro Antonio, Estuve buscando la opcion que me dijiste tengo un tema con el rango, Por ej en la columnas, deberia utilizar algo como "cells.select" para que lo busque en toda la hoja, Sin embargo, Sigo como una loca sin poder encontrar la solucion a este codigo.

Es medio frsutrante debido a que el excel para vba no es lo mismo para mi que vba y me termina mareando.

Agradeceria muchismo que puedas indicarme otra ayuda.

Besos.

Camila

Antoni · el 18 de abril

No acabo de ver claro que es lo que pretendes.

Sube un archivo con un ejemplo para que se vea mas claro.

enfan · el 18 de abril

Ante todo quiero agradecerte por el tiempo que me estas dedicando, Nunca habia navegado en foros y siempre que lo hize de niña nunca recibia respuesta, Valoro mucho tu atencion y desde ya te lo agradezco:), Me lo estan solicitando en mi trabajo y estoy perdida.

Eh subido el archivo con espero que puedas darme una manito.

Besos

Camila

Archivo ejemplo macro antonio.xls

Antoni · el 19 de abril

Abre el adjunto y pulsa sobre la flecha azul "COPIAR".

A ver si es eso lo que quieres.

Archivo ejemplo macro antonio (1).xls

enfan · el 22 de abril

Macro Antonio: Muchas gracias por tu aporte! Te estoy subiendo el archivo completo me esta tirando un error que no lo entiendo, Pero creo que ya casi esta, Probe modificando varia variables pero no he podido pegar en el clavo.

Te Mando un beso

Camila.

GENERAR_ CONSOLIDADO_CAMILA.xls

nachobm · el 22 de abril

Hola enfan,

Sin tener muy claro lo que hace el libro te dire que en el módulo 1 había algún error de programación. Otro error que te puede dar es que necesita que en el libro(s) de origen dede haber una hoja llamada "sheet2" y una hoja llamada "BD PIVOT". A la copia que te mando le he anulado el on error goto finaliza para saber exactamente donde da el error.

copia de GENERAR_ CONSOLIDADO_CAMILA.xls

Antoni · el 22 de abril

Estando de acuerdo con lo que nos cuenta nachobm te dejo la macro a ver si acertamos:

Sub copiar_datos(ByVal Archivo_origen_ruta As String, ByVal Archivo_destino As String) 


Dim Archivo_origen As String, RsBusq As Range, ROFO As String

Dim Rango As Range, Fila As Long, ÚltimaFila As Long


Archivo_origen = Dir(Archivo_origen_ruta)


Application.ScreenUpdating = False

[B]Workbooks(Archivo_origen).Activate

Workbooks(Archivo_origen).Sheets("BD PIVOT").Activate[/B]


ÚltimaFila = ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Rows.Count - 1

For Fila = ActiveSheet.UsedRange.Row To ÚltimaFila

   Application.StatusBar = "Procesando fila " & Fila & " / " & ÚltimaFila

   If (Range("A" & Fila).Value = "ROFO March 2013") Then

       If Rango Is Nothing = True Then

          Set Rango = Rows(Fila)

       Else

          Set Rango = Application.Union(Rango, Rows(Fila))

       End If

   End If

Next Fila


[B]Workbooks(Archivo_destino).Activate[/B]

Sheets("Sheet2").Cells.Clear

[B]Workbooks(Archivo_origen).[/B]Rows(1).Copy Sheets("Sheet2").Rows(1)

If Rango Is Nothing = False Then

   Rango.Select

   Selection.Copy Sheets("Sheet2").Range("A2")

End If


End Sub

[/CODE]

Si en el [b]Archivo_destino[/b] no hay una hoja con el nombre [b]Sheet2[/b], esto no va a funcionar.

enfan · el 22 de abril

Hola Muchachos!!!! Ambos son unos genios!!!Nacho BM Agradezco mucho que te hayas metido en el post ya lo estaba volviendo loco a Antonio, Y tu Macro antonio gracias por estar pendiente sinceramente lo agradezco, La macro esta corriendo por primera vez, Esta abriendo libro por libreo el tema es que no esta haciendo el copiado dice error:438 Object doesn support this property or method(?)

No entiendo a que se debe, Tampoco me lleva a algun lugar del Modulo para chequearlo, Tiene idea que sera?

- - - - - Mensaje combinado - - - - -

Estoy tratando de econtrar el error de compilacion Este es el codigo, Le modifique el "sheets 2":



Sub copiar_datos(ByVal Archivo_origen_ruta As String, ByVal Archivo_destino As String)


Dim Archivo_origen As String, RsBusq As Range, ROFO As String

Dim Rango As Range, Fila As Long, ÚltimaFila As Long



Archivo_origen = Dir(Archivo_origen_ruta)



Application.ScreenUpdating = False

Workbooks(Archivo_origen).Activate

Workbooks(Archivo_origen).Sheets("BD PIVOT").Activate


ÚltimaFila = ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Rows.Count - 1

For Fila = ActiveSheet.UsedRange.Row To ÚltimaFila

   Application.StatusBar = "Procesando fila " & Fila & " / " & ÚltimaFila

   If (Range("A" & Fila).Value = "ROFO March 2013") Then

       If Rango Is Nothing = True Then

          Set Rango = Rows(Fila)

       Else

          Set Rango = Application.Union(Rango, Rows(Fila))

       End If

   End If

Next Fila



Workbooks(Archivo_destino).Activate

Sheets(1).Cells.Clear

Workbooks(Archivo_origen).Rows(1).Copy Sheets(1).Rows(1)

If Rango Is Nothing = False Then

   Rango.Select

   Selection.Copy Sheets(1).Range("A2")

End If



End Sub



[/CODE]

Besos! Cami

nachobm · el 23 de abril

debes cambiar

Workbooks(Archivo_destino).Activate Sheets(1).Cells.Clear 
Workbooks(Archivo_origen).Rows(1).Copy Sheets(1).Rows(1) 
If Rango Is Nothing = False Then   
 Rango.Select    
Selection.Copy Sheets(1).Range("A2") 
End If[/PHP]

por

[PHP]
Workbooks(Archivo_origen).ActiveSheet.Rows(1).Copy Sheets(1).Rows(1)
If Rango Is Nothing = False Then
Workbooks(Archivo_destino).Sheets(1).Cells.Clear
Workbooks(Archivo_destino).Sheets(1).Activate
Rango.Select
Selection.Copy Sheets(1).Range("A2")
End If[/PHP]

con esto no da error pero aseguraté que funciona como tu quieres

enfan · el 23 de abril

Hola Nacho como estas????? Te comento que el error no lo esta mostrando mas, Vos en algun momento de este post me habia comentado algo de la linea de error que le habias sacado para ver donde fallaba, Sabes que ahora abre los archivos y cuando los deberia pegar se queda trabada y me pide denuevo el nombre del archivo de origen, Limpie la macro por todos lados pero es como que entra en una linea de codigo luego de buscar y encontrar las palabras no llega a copiarlas. Me tome el atrevimiento de armar una carpeta con el archivo de la macro y dos hojas de datos para ver si puedes chequearlo tu o alguien mas que pueda darme una mano como lo han hecho tu y Antonio, Estoy muy contenta por poder cambiar dudas con ustedes. Les dejo el archivo. Muchos Besos, Camila:)

MACRO.zip

nachobm · el 25 de abril

La macro queda así :


Sub copiar_datos(ByVal Archivo_origen_ruta As String, ByVal Archivo_destino As String)

Dim Archivo_origen As String, RsBusq As Range, ROFO As String
Dim Rango As Range, Fila As Long, ÚltimaFila As Long
Dim i As Long, s_r, ii As Long, r As Long


Archivo_origen = Dir(Archivo_origen_ruta)


Application.ScreenUpdating = False
Workbooks(Archivo_origen).Activate
Workbooks(Archivo_origen).Sheets("BD PIVOT").Activate

With ActiveSheet.UsedRange
    ÚltimaFila = .Row + .Rows.Count - 1
    ReDim s_r(1 To ÚltimaFila) As String
    i = 1
    s_r(1) = .Row + 1 & ":" & .Row + 1
    For Fila = .Row + 2 To ÚltimaFila
        Application.StatusBar = "Procesando fila " & Fila & " / " & ÚltimaFila
        If (Range("A" & Fila).Value = "ROFO March 2013") Then
            If Len(s_r(i) & "," & Fila & ":" & Fila) > 255 Then
                i = i + 1
                s_r(i) = Fila & ":" & Fila
            Else
                s_r(i) = s_r(i) & "," & Fila & ":" & Fila
            End If
        End If
    Next Fila
 End With

Workbooks(Archivo_destino).Sheets(1).Columns("a:z").AutoFit

For ii = 1 To i
    r = Workbooks(Archivo_destino).Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row + 1
    Workbooks(Archivo_origen).ActiveSheet.Range(s_r(ii)).Copy _
    Workbooks(Archivo_destino).Sheets(1).Rows(r)

Next

End Sub
[/PHP]

copia, pega y comenta

enfan · el 25 de abril

Bueno, Luego de un mes programando como una Loca habia llegado al punto de total Frustracion....

Totalmente decidida a dejar Esta macro de lado y de decirle a mi jefe que realmente no podria hacerlo.

De casualidad llegue a este foro, Y mi primera expectativa fue "Seguro nadie me va a prestar atencion"

Mas equivocada no podia estar....

En Principio Con la ayuda de Macro Antonio Pude ir viendo errores los cuales luego de estar horas y horas sentada frente al ordenador se me pasaban por alto.

Y gracias a NACHOBM, Con su paciencia, Dedicacion Dado que se encuntra con poryectos y totalmente Falto de tiempo Pude Solucionar mi problam un dia antes del deadline.

Pocas son las Palabra que tengo para expresar la alegria que siento en este momento, El soporte recibido es algo que pense que no podia llegar a darse en un foro, Somo personas las cuales no nos conocemos, De paises diferentes , Modos diferentes y Costumbres diferentes.

Macro antonio gracias por ayuydarme y ver mis errores

NachoBM Gracias..... Grcias, Gracias y mas gracias, Eres un sol y No se como agradecerte esto, Las Palabras son pocas para demostrar lo que siento.

Para le gente que comienza en el foro: Esten tranquilos, Lean las Normas, Hay gente super capaz dispuesta a ayudar.

Esto es la MECA del soporte en Grupo.

No puedo estar mas Contenta.

TEMA SOLUCIONADO.

Camila Rodriguez Cassa.