Anónimo
Copiar rango de celdas según condición VBA
b1 = NOMBRE
b2 = uriel
b3 = oscar
b4 = abel
b5 = lorena
b6 = oscar
Lo que busco es que la macro inicie su búsqueda en b2, me detecte la fila que tiene el nombre oscar y me copie un rango correspondiente a esa fila digamos detecta la celda b3 = oscar y copia el rango c3:f3 y lo pega en una segunda hoja en a1, esto que se repita en cada fila de la columna B, si coincide con la condición oscar que copie y pegue en la segunda hoja en a1, si concide con la condición uriel que copie y pegue en la segunda hoja en a30, si coincide con abel copiar y pegar en la segunda hoja en a60.
2 Respuestas
Estaba buscando algo similar, creé unas condicionales y cuando se cumple estas me dicen "SI" y es ese valor junto a los 3 que hay a la derecha, en total 4, son los que necesito copiar en otra hoja. Así quedó mi código, obviamente cuadrando la fila y la columna donde tengo mis datos, en mi caso es "M14" lo que requiero copiar y el nombre de las celdas, en mi caso el origen se llama "dic" y donde quiero pegar se llama "Hoja1".
Posdata: si alguien intenta algo similar, tener en cuenta las mayúsculas, en primera instancia en el código puse "hoja1" sin la mayúscula y no me sirvió, cuando cambié la mayúscula y puse "Hoja1" si me funcionó.
Gracias por el aporte, a continuación como me quedó el código.
╚╚╚╚╚╚╚╚╚╚╚╚╚╚╚╚╚╚╚╚╚╚╚╚╚╚╚╚╚╚╚╚╚╚╚╚╚╚╚╚╚╚╚╚╚╚╚╚╚╚╚╚╚╚╚╚
Sub Copiar()
Sheets("dic").Select
Range("M14").Select
Do While ActiveCell <> ""
If ActiveCell = "SI" Then
ActiveCell.Select
Range(ActiveCell, ActiveCell.Offset(0, 4)).Select
Selection.Copy
Sheets("Hoja1").Select
Range("a1").Select
Do While ActiveCell <> ""
ActiveCell.Offset(1, 0).Select
Loop
ActiveSheet.Paste
End If
Sheets("hoja1").Select
ActiveCell.Offset(1, 0).Select
Loop
End SubSub Copiar()
Sheets("dic").Select
Range("M14").Select
Do While ActiveCell <> ""
If ActiveCell = "SI" Then
ActiveCell.Select
Range(ActiveCell, ActiveCell.Offset(0, 4)).Select
Selection.Copy
Sheets("Hoja1").Select
Range("a1").Select
Do While ActiveCell <> ""
ActiveCell.Offset(1, 0).Select
Loop
ActiveSheet.Paste
End If
Sheets("hoja1").Select
ActiveCell.Offset(1, 0).Select
Loop
End Sub
Sub Copiar_Rango()
'selecciona rango b2
Range("B2").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 nombre oscar copie
'desde esa celda hasta las 5 columnas siguientes
If ActiveCell = "oscar" Then
Selection.Copy
Sheets("hoja2").Select
Range(ActiveCell, ActiveCell(0, 5)).Select
'inicia otro bucle para encontrar una celda en blanco para pergar el contenido copiado anteriormente
Do While ActiveCell <> ""
ActiveCell.Offset(1, 0).Select
Loop
ActiveSheet.Paste
End If
Sheets("hoja1").Select
ActiveCell.Offset(1, 0).Select
Loop
End Sub
Lo que hace este código es buscar la palabra oscar y si la encuentra copia desde donde dice oscar hasta las 5 columnas siguientes y después lo pega en la hoja2 en la celda a1 y se regresa a la hoja1 y busca la palabra oscar y si la encuentra la copia nuevamente y la pega en la hoja 2 el celda a2 y así sucesivamente... para hacerlo con los demás nombres se hace de la misma manera solo que en lugar de ponerle al código oscar pues agregas el nombre que se va a buscar.
Espero haberte ayudado, no olvides calificar y finalizar la pregunta.
Copie el código tal como esta, sin embargo me marca un error de ejecución en la siguiente linea -----> Range(ActiveCell, ActiveCell(0, 5)). Select
Trate de analizar el código para entenderlo y así encontrar el error pero algunas lineas no me cuadran, copie el código y le agregue comentarios para ver si estoy entendiendo
Sub Copiar_Rango2()
Range("B2").Select
Do While ActiveCell <> ""
If ActiveCell = "oscar" Then
Selection.Copy 'en esta linea que se esta copiando?
Sheets("hoja2").Select 'aqui se pasa a la hoja 2 pero que se copio?
Range(ActiveCell, ActiveCell(0, 5)).Select 'aqui se selecciona un rango, pero de que hoja y faltaria copiarla?
'de este codigo me perdi aun mas
Do While ActiveCell <> ""
ActiveCell.Offset(1, 0).Select
Loop
ActiveSheet.Paste
End If
Sheets("hoja1").Select
ActiveCell.Offset(1, 0).Select
Loop
End Sub
Disculpa la molestia
Gracias por tu apoyo, saludos.
Sub Copiar_Rango()
'selecciona rango b2
Sheets("hoja1").Select
Range("B2").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 nombre oscar copie
'desde esa celda hasta las 5 columnas siguientes
If ActiveCell = "oscar" Then
ActiveCell.Select
Range(ActiveCell, ActiveCell.Offset(0, 5)).Select
Selection.Copy
Sheets("hoja2").Select
Range("a1").Select
'inicia otro bucle para encontrar una celda en blanco para pergar el contenido copiado anteriormente
Do While ActiveCell <> ""
ActiveCell.Offset(1, 0).Select
Loop
ActiveSheet.Paste
End If
Sheets("hoja1").Select
ActiveCell.Offset(1, 0).Select
Loop
End Sub
Revisa y me explicas como te fue.
Nuevamente muchas gracias y espero que estés muy bien, cualquier cosa si puedo ayudarte cuenta conmigo.
Saludos!