Macro que busque un valor en una columna y que lo pegue en otra columna de otro libro.

Tengo un señor problema, resulta que tengo 20 datos en la columna E de un libro llamado DESVIACIONES, necesito buscar desde la E7 hasta la E26 los datos mayores o iguales a 0, si encuentra alguno que lo copie y lo peque en otra hoja llamada Hoja2 en la columna D empezando desde la D5, teniendo cuidado de que verifique si no hay algún dato en dichas celdas para poder pegar el nuevo dato.

He hecho este código pero no me funciona como quiero. Espero me ayuden

Sub Mantenimiento()
For x = 1 To 20
Sheets("Desviaciones").Select
Range("E7").Select
If (Range("E7").Value = "No hay desviaciones") Then
ActiveCell.Offset(1, 0).Select
Else
If (Range("E7").Value >= 0) Then
dirección = ActiveCell.Address
ActiveCell.Copy
Sheets("Hoja2").Select
Range("D5").Select
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Select
Loop
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Sheets("Desviaciones").Select
Range(dirección).Select
ActiveCell.Offset(1, 0).Select
End If
End If
Next
End Sub

1 respuesta

Respuesta
2

Necesito una aclaración:

¿Tenemos dos archivos distintos o dentro del mismo archivo tenemos la pestaña DESVIACIONES y la pestaña HOJA2?

Hola, están dentro del mismo archivo solo que en diferentes pestañas....

Saludos

Hola, quería agregar algo más, en la columna E pueden haber datos >0 asi como también una frase que dice "No hay desviaciones", mi misión es encontrar los valores >0 en la columna E si encuentra alguno que lo copie y lo pegue en otra hoja llamada Hoja2 en la columna D empezando en D5 siempre verificando que no se encuentre ocupada, si no que salte a la siguiente celda, si no encuentra valores en la columna E tendría que aparecer un mensaje que diga "No hay desviaciones"

Espero haber sido explicito, de antemano muchísimas Gracias por tomarse el tiempo para ayudarme en mi trabajo.

Te mando mi solución. Sigue mis instrucciones:

Tenemos los datos en la pestaña DESVIACIONES y queremos analizar la columna E.

Tenemos otra pestaña llamada HOJA2 en blanco preparada para recibir datos.

Ejecuta esta macro y todo listo:

Sub ejemplo()
'por luismondelo
fila = 5
Sheets("desviaciones").Select
Range("e7").Select
Do While ActiveCell.Value <> ""
If IsNumeric(ActiveCell) And ActiveCell.Value > 0 Then
ActiveCell.Copy Destination:=Sheets("hoja2").Cells(fila, 4)
x = x + 1
fila = fila + 1
ElseIf UCase(ActiveCell.Value) = "NO HAY DESVIACIONES" Then
a = a + 1
ElseIf UCase(ActiveCell.Value) <> "NO HAY DESVIACIONES" And Not IsNumeric(ActiveCell) Then
b = b + 1
End If
ActiveCell.Offset(1, 0).Select
Loop
MsgBox "Total celdas con el texto 'no hay desviaciones': " & a & Chr(13) & "Total celdas con otros textos: " & b & Chr(13) & "Total de celdas copiadas con valores >0: " & x
End Sub

recuerda finalizar y puntuar

Hola, pues el código funciona excelente solo que tengo un problema, en caso de que existiera algún dato en las celdas de la columna D de la hoja 2, el programa me las borra... Que le puedo agregar para que verifique que la celda esta vacía?

Gracias.

En ese caso la macro a utilizar sería esta:

Sub ejemplo()
'por luismondelo
fila = sheets("hoja2").range("d65000").end(xlup).row+1
if fila <7 then fila =7
Sheets("desviaciones").Select
Range("e7").Select
Do While ActiveCell.Value <> ""
If IsNumeric(ActiveCell) And ActiveCell.Value > 0 Then
ActiveCell.Copy Destination:=Sheets("hoja2").Cells(fila, 4)
x = x + 1
fila = fila + 1
ElseIf UCase(ActiveCell.Value) = "NO HAY DESVIACIONES" Then
a = a + 1
ElseIf UCase(ActiveCell.Value) <> "NO HAY DESVIACIONES" And Not IsNumeric(ActiveCell) Then
b = b + 1
End If
ActiveCell.Offset(1, 0).Select
Loop
MsgBox "Total celdas con el texto 'no hay desviaciones': " & a & Chr(13) & "Total celdas con otros textos: " & b & Chr(13) & "Total de celdas copiadas con valores >0: " & x
End Sub

recuerda finalizar

Hola, tengo una duda cuando corro la macro en mi Libro, se detiene cuando encuentra una celda vacía, tengo 120 datos en la columna E y pues algunas celdas se encuentran vacías que le tendría que agregar para que no se detenga aun cuando encuentre celdas vacías ?

Gracias por su valiosa ayuda

En ese caso la macro que tienes que utilizar es esta:

(Ya no se parará cuando encuentre una celda en blanco)

Sub ejemplo()
'por luismondelo
fila = sheets("hoja2").range("d65000").end(xlup).row+1
if fila <7 then fila =7
Sheets("desviaciones").Select
range("e65000").end(xlup).offset(1,0).value ="final"
Range("e7").Select
Do While ActiveCell.Value <> "final"
If IsNumeric(ActiveCell) And ActiveCell.Value > 0 Then
ActiveCell.Copy Destination:=Sheets("hoja2").Cells(fila, 4)
x = x + 1
fila = fila + 1
ElseIf UCase(ActiveCell.Value) = "NO HAY DESVIACIONES" Then
a = a + 1
ElseIf UCase(ActiveCell.Value) <> "NO HAY DESVIACIONES" And Not IsNumeric(ActiveCell) Then
b = b + 1
End If
ActiveCell.Offset(1, 0).Select
Loop
activecell.clearcontents
MsgBox "Total celdas con el texto 'no hay desviaciones': " & a & Chr(13) & "Total celdas con otros textos: " & b & Chr(13) & "Total de celdas copiadas con valores >0: " & x
End Sub

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas