Macro copiar datos de una fila a otra según valor celda

Quisiera saber qué código VBA usar para que me busque en un rango concreto un fila con un valor específico de una celda (A1) y que me pegue esa fila a otro rango que contenga otra celda que coincida con el mismo valor de (A1). Estoy probando este código pero me da error.

Sub Copiar_RangoOK()
'selecciona rango h4
Sheets("hoja1").Select
Range("h4").Select
'inicia bucle hasta que se encuentre una celda en blanco
Do While ActiveCell <> ""
'condición en la que decimos que si se encuentra el valor de A1 copie
'desde esa celda hasta las 10 columnas siguientes
If ActiveCell = Range("A1") Then
ActiveCell.Select
Range(ActiveCell, ActiveCell.Offset(0, 10)).Select
Selection.Copy
'selecciona rango h4
Sheets("hoja1").Select
Range("h16").Select
'inicia bucle hasta que se encuentre una celda en blanco
'condición en la que decimos que si se encuentra el valor de A1 pegue
'desde esa celda hasta las 10 columnas siguientes
Do While ActiveCell <> ""
Range(ActiveCell, ActiveCell.Offset(0, 10)).Select
Loop
ActiveSheet.Paste
End If
Loop
End Sub

1 respuesta

Respuesta
2

Antes de revisar el código o de crear una nueva macro, puedes explicar con ejemplos y con datos reales lo que tienes y lo que quieres de resultado

OK, tengo dos rangos de datos (H4:M10) y (H16:M23) en donde la primera celda de cada fila tiene un valor que es coincidente en cada rango, necesito que en función del valor de la celda "A1" copie la fila coincidente y la pegue en la fila con el mismo valor del otro rango.

Ejemplo: valor de  "A1" es 0120, quiero que copie la fila que empiece con  0120 del primer rango y pegue los valores en la fila del otro rango que empiece con  0120.

Saludos

Te anexo la macro

Sub CopiarDatos()
'Por.Dante Amor
    Set b = Range("H4:H10").Find([A1], lookat:=xlWhole)
    If Not b Is Nothing Then
        f = b.Row
        Set c = Range("H16:H23").Find([A1], lookat:=xlWhole)
        If Not c Is Nothing Then
            Range("H" & f & ":M" & f).Copy Range("H" & c.Row)
        Else
            MsgBox "El dato de la celda A1 no existe en el segundo rango"
        End If
    Else
        MsgBox "El dato de la celda A1 no existe en el primer rango"
    End If
End Sub

Saludos.Dante Amor

Muchisimas gracias por tu pronta respuesta, va perfectamente. 

Solamente una duda, si quisiera copiar una rango fijo (H4:N4) ubicado en un diferente libro (libro2) y que lo copiase en en la fila coincidente con la celda A1 del otro rango en el libro1 (como antes). ¿cuál sería el código? No acabo de entender el código por eso no sé como adaptarlo a ese caso

Gracias

Podrías valorar esta respuesta y crear una nueva pregunta.

De igual manera en la nueva pregunta me explicas con un ejemplo y con datos reales lo que necesitas.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas