• 👏 Bienvenido a nuestra comunidad Excel

    ¿Todavía no estás registrado? 😲

    Registrate gratis aquí y podrás:

    💪 Hacer preguntas a los expertos
    ⬇️ Descargar ejemplos y plantillas
    🏅 
    Acceder a contenidos premium

Macro para copiar filas con condición a hojas diferentes

DanielQH

New member
Hola buen día!

antes que nada les agradezco la atención,

necesito crear una macro que encuentre el valor de una celda (1-7), copie, y pegue la fila en la hoja que le corresponde (igual 1-7),

me pueden ayudar? dejo el archivo de excel

les mando un fuerte abrazo
 

Adjuntos

Cacho R

Well-known member
Hola! Daniel (y Antoni)
Para "mi gusto" sólo te falta aclarar una cosa: la info a copiar... ¿Reemplaza la que pudiera estar existente o se acumula a la info previa de cada hoja?

Saludos, Cacho R.
.
 

DanielQH

New member
Hola Cacho, la info debería ser reemplazada cada vez que se pase a la hoja correspondiente o por lo menos así me la imagino, por supuesto que como de esto no se nada, pues estoy abierto a sugerencias y cualquier tipo de ayuda.

Saludos y gracias!
 

Cacho R

Well-known member
Ok, Daniel. Entonces intenta con lo que sigue:
Código:
Sub distribuir_según_Hoja()
Dim Rng As Range, C As Range, ws As Worksheet
Application.ScreenUpdating = False
Set Rng = Range("b12:u" & [p12].End(xlDown).Row)
[at1] = [q12].Value
Rng.AdvancedFilter 2, "", [at1], True
Set C = [at2]

On Error Resume Next
Do While C <> ""
  Err.Clear
  Set ws = Sheets(CStr(C))
  If Err.Number Then
    MsgBox "La hoja '" & C & "' no se encuentra en este libro."
    Exit Sub
  End If
  Set C = C.Offset(1)
Loop
On Error GoTo 0
  
Do
  Set ws = Sheets(CStr([at2]))
  ws.Range("b13:u" & ws.Cells(Rows.Count, "q").End(xlUp).Row).Delete xlShiftUp
  
  Rng.AdvancedFilter 2, Rng.Worksheet.[at1:at2], ws.[b13], False
  ws.[b13].CurrentRegion.Columns.AutoFit
  Rng.Worksheet.[at2].Delete xlShiftUp
Loop Until Rng.Worksheet.[at2] = ""

Rng.Worksheet.Range("at1:at5").Delete xlShiftUp
Application.ScreenUpdating = True
End Sub
 
Arriba