Macro para renombrar celdas buscando un valor en otra hoja
Para Dante.
Hola Dante. Tengo una tabla con unas tarjetas donde viene su numeración y la descripción.
En otra tabla tengo estas mismas tarjetas pero la descripción es muy genérica, se llaman igual.
Quisiera cambiar la descripción de las tarjetas en la segunda hoja por el nombre que aparece en la primera hoja, por ejemplo en de PROVISI que pusiera PROVISIONAL1o la que toque.
Estoy probando con este código basado en otro que me hiciste tú, pero no consigo que lo haga.
Sub RenombrarProvisional()
Set h1 = Sheets("CalculoOTSolred")
Set h2 = Sheets("ProvisionalSOLRED")
Set r = h2.Columns("A") 'columna de tarjetas
For i = 365 To h1.Range("H" & Rows.Count).End(xlUp).Row 'para cada tarjeta
Set b = r.Find(Val(h1.Cells(i, "H")), LookAt:=xlWhole)
If Not b Is Nothing Then
celda = b.Address
Do
h1.Cells(i, "I") = h2.Cells(b.Row, "B")
Exit Do
Set b = r.FindNext(b)
Loop While Not b Is Nothing And b.Address <> celda
End If
Next
End SubComo los números de tarjeta son tan largos aparece siempre una " ' " al principio. No se y el formato de estos números está complicando la búsqueda o que el código que he adaptado no lo he hecho bien.
Te pido ayuda porque llevo mucho rato intentándolo y no veo el fallo.
1 Respuesta
Si en las 2 columnas tienes el apostrofe ' entonces no es necesario poner Val( )
Prueba con los siguiente:
Sub RenombrarProvisional()
Set h1 = Sheets("CalculoOTSolred")
Set h2 = Sheets("ProvisionalSOLRED")
For i = 365 To h1.Range("H" & Rows.Count).End(xlUp).Row 'para cada tarjeta
Set b = h2.Columns("A").Find(h1.Cells(i, "H"), LookAt:=xlWhole)
If Not b Is Nothing Then
h1.Cells(i, "I") = h2.Cells(b.Row, "B")
End If
Next
End SubSi no está encontrando los datos, entonces prueba con esto:
Sub RenombrarProvisional()
Set h1 = Sheets("CalculoOTSolred")
Set h2 = Sheets("ProvisionalSOLRED")
For i = 365 To h1.Range("H" & Rows.Count).End(xlUp).Row 'para cada tarjeta
Set b = h2.Columns("A").Find(Val(h1.Cells(i, "H")), LookAt:=xlWhole)
If Not b Is Nothing Then
h1.Cells(i, "I") = h2.Cells(b.Row, "B")
End If
Next
End Subsal u dos
Dante, el error persiste, no encuentra la tarjeta. De ninguna de las dos maneras.
Te envío por mail el fichero para que lo puedas comprobar mejor.
Gracias.
Moisés.
En el asunto del correo pon tu nombre de usuario.
¡Gracias!
Te lo acabo de enviar.
Moisés.
Con esta macro me funciona
Sub RenombrarProvisional()
'Por.Dante Amor
Application.ScreenUpdating = False
Application.StatusBar = False
Set h1 = Sheets("CalculoOTSolred")
Set h2 = Sheets("ProvisionalSOLRED")
u = h1.Range("H" & Rows.Count).End(xlUp).Row
For i = 2 To u 'para cada tarjeta
Application.StatusBar = "Procesando registro : " & i & " de : " & u
Set b = h2.Columns("A").Find(h1.Cells(i, "H"), LookAt:=xlWhole)
If Not b Is Nothing Then
h1.Cells(i, "I") = h2.Cells(b.Row, "B")
End If
Next
Application.ScreenUpdating = True
Application.StatusBar = False
MsgBox "Fin"
End Sub
