1

actualmente estoy trabajando en un código el cuál debe:

  1. Leer el ítem que el usuario seleccione de un Combobox, por ejemplo:

introducir la descripción de la imagen aquí

  1. Ir a una hoja llamada "MEMORIAS ACTO" y hacer la búsqueda de dicho ítem, en las columnas "CJ" y "CK" (se hace en estas 2 columnas ya que los encabezados están en una celda combinada)

introducir la descripción de la imagen aquí

  1. Como pueden ver el ítem que se busca es el encabezado de unos cuadros, una vez que se encuentre el ítem que el usuario desea buscar se debe copiar los datos que le pertenecen a ese ítem y llevarlos a una hoja llamada "EMPALMES"

introducir la descripción de la imagen aquí

Se copian y como dije se llevan a la hoja "EMPALMES" y en dicha hoja se deben pegar lo elementos a partir de la celda B2, de la siguiente forma:

introducir la descripción de la imagen aquí

Les adjunto el código que yo misma hice para tratar de hacer todo lo anterior, pero el código no me funciona, siempre me sale o el error 13 (no coinciden los tipos) o el 404 (Se requiere un objeto)

    Private Sub cmdagacc_Click()

Set h1 = Sheets("MEMORIAS ACTO")    'Origen
Set h2 = Sheets("EMPALMES")         'Destino


Set R1 = h1.Range("CJ29")
Set R2 = h1.Range("CJ87")
Evn = cbxtacc.Value
Dim rng As Range

If cbxtacc.Value = "" Or cbxtacc.ListIndex = -1 Then
    MsgBox "Seleccione un tipo de Accesorio"
    cbxtacc.SetFocus
    Exit Sub
End If

Existe = False
Dim R As Object
Set b = h1.Range("CJ29:CK87").Find(Evn, LookIn:=xlValues, LookAt:=xlWhole)

If Not b Is Nothing Then
    cl = b.Address

    Do
        Fila = b.Row + 1
        k = 2
        For j = Cells("CJ29").Cells To Columns("CK87").Column
            If h1.Cells(Fila, j).Value = cbxtacc.Value Then
                Existe = True
                Fila = Fila + 1
                k = k + 1
            Do While h1.Cells(Fila, j).Value <> ""
                h2.Cells(k, "B").Value = h1.Cells(Fila, j).Value
                h2.Cells(k, "C").Value = h1.Cells(Fila, j + 1).Value
                Fila = Fila + 1
                k = k + 1
            Loop
        Exit For
            End If
        Next

    Loop While Not b Is Nothing And b.Address <> cl
End If

If Existe = False Then
    MsgBox "Error al agregar los Accesorios", vbExclamation
Else
    MsgBox "Accesorios agregados", vbInformation
End If

Range("A1") = "Empalmes"

End Sub

Agradezco toda la ayuda que me puedan dar, y espero a ver logrado explicarme con claridad

16
  • Deberiamos dejar de vernos asi.. :p.. escucha cuando la celda es combinada no tiene como coordenada la de la primera? y me indicas en que lineas te sale el error?
    – gbianchi
    Commented el 27 jul. 2018 a las 17:16
  • Jejeje tal vez. También he intentado hacer la búsqueda usando como referencia la primer celda, pero es el mismo resultado y el error sale en la linea Set R = h1.Range("CJ" & Rows.Count).End(xlUp).Row Commented el 27 jul. 2018 a las 18:03
  • que es Rows.count?
    – gbianchi
    Commented el 27 jul. 2018 a las 18:04
  • Es para contar filas Commented el 27 jul. 2018 a las 18:08
  • Si, pero no es null ahi rows? De donde viene?
    – gbianchi
    Commented el 27 jul. 2018 a las 18:09

1 respuesta 1

2

Espero que este código te sea de utilidad:

Option Explicit
Private Sub cmdagacc_Click()

    Dim wb As Workbook, h1 As Worksheet, h2 As Worksheet
    Dim R1 As Range
    Dim Evn As String
    Dim FilaI As Long, FilaF As Long, LastRow As Long

    Set wb = ThisWorkbook 'es importante hacer referencia al libro además de la hoja, por si hay otros libros con hojas del mismo nombre
    Set h1 = wb.Sheets("MEMORIAS ACTO")
    Set h2 = wb.Sheets("EMPALMES")

    If cbxtacc.Value = "" Or cbxtacc.ListIndex = -1 Then
        MsgBox "Seleccione un tipo de Accesorio"
        cbxtacc.SetFocus
        Exit Sub
    Else
        Evn = cbxtacc.Value
    End If

    LastRow = h1.Range("CJ100000").End(xlUp).Row 'contamos hasta la última fila para que a medida que se añadan cosas, el rango aumente
    Set R1 = h1.Range("CJ29:CK" & LastRow) 'este rango será dinámico entendiendo que los accesorios comienzan en la fila 29 y terminan en la 100000

    FilaI = R1.Cells.Find(Even).Row 'buscamos la fila en la que se encuentra lo que queremos
    FilaF = h1.Cells(FilaI, "CJ").End(xlDown).Row 'buscamos la fila en la que termina teniendo en cuenta que siempre dejas una fila en blanco entre grupos de accesorios

    h1.Range(h1.Cells(FilaI + 1, "CK"), h1.Cells(FilaF, "CJ")).Copy 'copiamos los datos
    h2.Cells(2, 2).PasteSpecial xlPasteValues 'pegamos sólo los valores


End Sub

Te recomiendo declarar las variables que vayas a utilizar en tus funciones ya que de lo contrario pueden haber errores, una opción muy buena para no olvidarte de ninguna variable sin declarar, es poner arriba del todo del módulo: Option Explicit ya que te obliga a declararlas todas.

Lo que yo te he puesto es un código que primero comprueba que tu combobox no está vacío y entonces le asigna el valor a Evn.

Después busca la última fila con datos en la hoja de memorias acto para que si añades accesorios no tengas que cambiar la macro. Hecho esto crea el rango R1 cogiendo desde la CJ29 (entiendo que ahí empieza el listado) y termina por la CK y la última fila que hubiera con datos.

Con todo eso hecho luego simplemente busco la fila en la que se encuentra el valor del combobox y la última fila mediante el método End (es como si aprietas la tecla ctrl+flecha de dirección en tu teclado, te situa en la última que haya datos en la dirección que le digas).

Una vez tengo comprendido el rango de datos que quiero copiar, pues simplemente copiar y pegar valores en la celda B2 de la hoja Empalmes.

Si no funciona es porque no encuentra el valor y eso pueden ser errores tipográficos.

1
  • Muchas gracias, tendré muy en cuenta el consejo que me das acerca de la declaración de variables, nuevamente muchas gracias, Me has ayudado bastante Commented el 6 ago. 2018 a las 14:00

Tu Respuesta

By clicking “Publica tu respuesta”, you agree to our terms of service and acknowledge you have read our privacy policy.

¿No es la respuesta que buscas? Examina otras preguntas con la etiqueta o formula tu propia pregunta.