Mejorar macro muy lenta
Tengo un problema con una macro que estoy haciendo. Tengo un comando while que va buscando en otra hoja las filas que corresponden con unas determinadas condiciones y de estas copiando unicamente determinadas celdas. El caso es que la ejecución de esta macro es lentísima... En la barra de estado me va poniendo:
"Calculando: (2 procesadores: xx%)"
con cada fila... Un horror! Imagino que es culpa mía y que se pueda hacer de otra forma mejor pero no se me ocurre... Quizá copiando toda la fila y luego eliminando lo que sobra... Aunque parece lo mismo... No se! Estoy perdido.
¿Alguna idea?
Os pongo la lenti-macro:
"Calculando: (2 procesadores: xx%)"
con cada fila... Un horror! Imagino que es culpa mía y que se pueda hacer de otra forma mejor pero no se me ocurre... Quizá copiando toda la fila y luego eliminando lo que sobra... Aunque parece lo mismo... No se! Estoy perdido.
¿Alguna idea?
Os pongo la lenti-macro:
While ActiveCell.Value <> "" And saldo < limite dato = ActiveCell.Value If dato = concepto Or dato = concepto2 Then Selection.Offset(0, -12).Copy Worksheets("acta").Cells(filadestino, 1).PasteSpecial Paste:=xlValues Selection.Offset(0, -11).Copy Worksheets("acta").Cells(filadestino, 2).PasteSpecial Paste:=xlValues Selection.Offset(0, -10).Copy Worksheets("acta").Cells(filadestino, 3).PasteSpecial Paste:=xlValues Selection.Offset(0, -9).Copy Worksheets("acta").Cells(filadestino, 4).PasteSpecial Paste:=xlValues Selection.Offset(0, -8).Copy Worksheets("acta").Cells(filadestino, 5).PasteSpecial Paste:=xlValues Selection.Offset(0, -7).Copy Worksheets("acta").Cells(filadestino, 6).PasteSpecial Paste:=xlValues Selection.Offset(0, -4).Copy Worksheets("acta").Cells(filadestino, 7).PasteSpecial Paste:=xlValues Selection.Offset(0, 0).Copy Worksheets("acta").Cells(filadestino, 8).PasteSpecial Paste:=xlValues Selection.Offset(0, 11).Copy Worksheets("acta").Cells(filadestino, 9).PasteSpecial Paste:=xlValues Selection.Offset(0, 12).Copy Worksheets("acta").Cells(filadestino, 10).PasteSpecial Paste:=xlValues Selection.Offset(0, 16).Copy Worksheets("acta").Cells(filadestino, 11).PasteSpecial Paste:=xlValues Selection.Offset(0, 17).Copy Worksheets("acta").Cells(filadestino, 12).PasteSpecial Paste:=xlValues saldo = Selection.Offset(0, 17).Value + saldo filadestino = filadestino + 1 End If ActiveCell.Offset(1, 0).Select WendGracias y un saludo.
Respuesta de Elsa Matilde
1