Copiar fila completa de una hoja a otra si cumple una condición

Aver si me pueden ayudar

CASO 1:Deseo que la macro copie toda la fila completa de la hoja1 pero que en la celda c tenga la palabra "exceso", y estas filas copiarlas a la hoja2 .

Algo así:

Pueden haber n filas Y n columnas en la hoja 1.

CASO 2:Deseo que la macro copie toda la fila completa de la hoja1 que en la celda c tenga la palabra "exceso" y copiar el valor de una celda especifica g1, y estas filas copiarlas a la hoja2 pero en otro orden .

Algo así:

Es decir copiar toda la fila con la palabra exceso de la hoja1 y pegarla en otro orden a la hoja 2 añadiendo el valor en la columna a el dato de la celda g1 de la hoja 1.

Si alguien me puede ayudar por favor. :(

---------------------------- ---------------------------

Yo probé grabando una macro haciendo todo el procedimiento filtrar, copiar, cambiar el orden, funciona pero demora demasiado. En el caso de revisar más de 50 archivos me demoro horas haciendo la labor, ojala alguien puede hacer una macro super rápida.

1 Respuesta

Respuesta
1

Este pequeño macro te hará esa tarea, ahora para los dos casos debes modificar el orden de copiado según tu criterio son 6 columnas, allí están las 6, podrás jugar con ellas a como desees que aparezcan en el otro libro filtras. Coloca dos botones y asignarles las macros con este código:

Dim i As Long

Dim Fila As Double
Dim x As Double

Fila = Hoja1.Range("A65000").End(xlUp).Row
x = 1
For i = 1 To Fila
If UCase(Hoja1.Range("C" & i).Value) = "EXCESO" Then
Hoja2.Range("A" & x).Value = Hoja1.Range("A" & i).Value
Hoja2.Range("B" & x).Value = Hoja1.Range("B" & i).Value
Hoja2.Range("C" & x).Value = Hoja1.Range("C" & i).Value
Hoja2.Range("D" & x).Value = Hoja1.Range("D" & i).Value
Hoja2.Range("E" & x).Value = Hoja1.Range("E" & i).Value
Hoja2.Range("F" & x).Value = Hoja1.Range("F" & i).Value
x = x + 1
End If
Next i

Estimado Ricardo primero quiero agradecerte por tu pronta respuesta, la macro funciona bien para el caso 1, 

Ahora tal vez me puedas ayudar a mejorar la macro pero para el caso 2:teniendo en cuenta lo siguiente:

  1. En la hoja 1, la celda G1 es un desplegable de tres opciones (almacen, cochera,patio) y la celda I1 desplegable 3 opciones (dia,tarde,noche); entonces al momento de pegar los valores en la hoja2 el valor de la celda G1 de la hoja1 debe copiarse en todas las filas pegadas de la celda A de la hoja2; de igual forma con la celda I2 de la hoja1.
  2. Tener en cuenta también que el pegado de las filas en la hoja2 debe ser a partir de la celda A5.
  3. cuando termine  la macro debe borrar todos los datos de la columna A hasta la F de la hoja1.
  4. Cuando se vuelva usar la macro con nuevos datos a copiarse deben agregarse en la hoja2 sin sobreescribir los datos que ya se encuentren  en la hoja 2, es decir pegar los datos después de la ultima fila con datos.

Saludos

caso 3:

Lo mismo que el caso 2, solo con la diferencia que si en la hoja1 el valor en la celda G1 es "Almacen"  el pegado se debe realizar en una hoja llamada "Almacen"; si en la hoja1 celda G1 dice "cochera" el pegado se realice en la hoja llamada "cochera".

Saludos , desde ya gracias por tu ayuda

Están los dos casos a ver si estos te funcionan al primer caso para que te siga copiando debajo de el ultimo registro debes cambiar la por por Fila2 declararla dentro de la macro e inicial izarla como lo hice en los dos casos

Caso 2

Dim i As Long
Dim Fila2 As Double
Dim Fila As Double
Dim x As Double

Fila = Hoja1.Range("A65000").End(xlUp).Row
Fila2 = Hoja2.Range("A65000").End(xlUp).Row
x = 1

For i = 1 To Fila

If UCase(Hoja1.Range("C" & i).Value) = "EXCESO" Then
Fila2 = Fila2 + 1
Hoja2.Range("A" & Fila2).Value = Hoja1.Range("G1").Value
Hoja2.Range("B" & Fila2).Value = Hoja1.Range("I1").Value
Hoja2.Range("C" & Fila2).Value = Hoja1.Range("D" & i).Value
Hoja2.Range("D" & Fila2).Value = Hoja1.Range("A" & i).Value
Hoja2.Range("E" & Fila2).Value = Hoja1.Range("B" & i).Value
Hoja2.Range("F" & Fila2).Value = Hoja1.Range("C" & i).Value
Hoja2.Range("G" & Fila2).Value = Hoja1.Range("E" & i).Value
Hoja2.Range("I" & Fila2).Value = Hoja1.Range("I" & i).Value

End If
Next i

Range("A2:K" & Fila2).Select
Selection.ClearContents

Caso 3

Dim i As Long
Dim Fila2 As Double
Dim Fila As Double
Dim x As Double

Fila = Hoja1.Range("A65000").End(xlUp).Row
Fila2 = Hoja2.Range("A65000").End(xlUp).Row
x = 1

For i = 1 To Fila

If UCase(Hoja1.Range("C" & i).Value) = "EXCESO" Then
Fila2 = Fila2 + 1

If Hoja1.Range("G1").Value = "ALMACEN" Then Hoja3.Activate
If Hoja1.Range("G1").Value = "COCHERA" Then Hoja4.Activate
If Hoja1.Range("G1").Value = "PATIO" Then Hoja5.Activate

If Hoja1.Range("G1").Value = "" Then

MsgBox ("ALMACEN NO IDENTIFICADO")
Exit Sub
End If

Range("A" & Fila2).Value = Hoja1.Range("G1").Value
Range("B" & Fila2).Value = Hoja1.Range("I1").Value
Range("C" & Fila2).Value = Hoja1.Range("D" & i).Value
Range("D" & Fila2).Value = Hoja1.Range("A" & i).Value
Range("E" & Fila2).Value = Hoja1.Range("B" & i).Value
Range("F" & Fila2).Value = Hoja1.Range("C" & i).Value
Range("G" & Fila2).Value = Hoja1.Range("E" & i).Value
Range("I" & Fila2).Value = Hoja1.Range("I" & i).Value

End If
Next i

Range("A2:K" & Fila2).Select
Selection. ClearContents

Muchas gracias funciona bien, ahora tengo un solo problema tengo una columna que usa una fórmula =CONSULTAV(K1, IDA!$B$1:$C$50,2,0) para todas sus celdas , el problema es cuando en x fila no encuentra el dato y la celda bota el error  #N/A y cuando esto sucede la macro ya no funciona, y sale el error : "Se ha producido el error '13' en tiempo de ejecucion: no coinciden los tipos.

Saludos, desde ya gracias por tu ayuda :)

Amigo para eso debo ver como se genera el error que linea es y el procedimiento del macro, si puedes manda el archivo a este correo y lo revisare [email protected]

Ya lo solucione con un sierror ,  el error era que yo modifique una columna con  formulas pero ya esta solucionado.

La macro anda bien, desde ya te agradezco por tomarte el tiempo en ayudarme, con la macro que me has enviado me has ahorrado varias horas de trabajo, muchas gracias. 

Siempre a tu orden amigo para eso estamos.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas