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]][1] 2. 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í][2]][2] 3. 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í][3]][3] 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í][4]][4] 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") K = 29 Set R = h1.Range("CJ" & Rows.Count).End(xlUp).Row N = "CJ" & K & ":A" & R 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 'Set rng = h1.Range("CJ29:CK87") 'Set rng = h1.Columns("CJ:CK") Set b = h1.Range(N).Find(Evn, LookIn:=xlValues, LookAt:=xlWhole) 'Set b = Sheets("MEMORIAS ACTO").Range("CJ29").Find(cbxtacc, 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("CK").Column For j = R1 To R2 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 [1]: https://i.sstatic.net/T73qq.png [2]: https://i.sstatic.net/AjyQ0.png [3]: https://i.sstatic.net/ZxxjE.png [4]: https://i.sstatic.net/xD7mc.png