modulo_buscador_embalajes.bas

  1. Attribute VB_Name = "modulo_buscador_embalajes"
  2.  
  3. Sub MacroBuscarSinParpadeo()
  4. Application.ScreenUpdating = False
  5. Call MacroBuscar
  6. Application.ScreenUpdating = True
  7. End Sub
  8.  
  9. Sub MacroBuscar()
  10. Attribute MacroBuscar.VB_ProcData.VB_Invoke_Func = " \n14"
  11.  
  12. 'Borrar el resultado anterior
  13. 'Hay que seleccionar con CTRL+* para toma la región actual
  14. Range("B12").Select
  15. Selection.CurrentRegion.Select
  16. Selection.EntireRow.Delete
  17.  
  18. 'Ir a la hoja de los datos
  19. Sheets("Base de Datos").Select
  20.  
  21. 'Volver a aplicar el filtro
  22. Range("I1").Select
  23. ActiveSheet.AutoFilter.ApplyFilter
  24.  
  25. 'Ordenar por la última columna
  26. Range("J1").Select
  27. ActiveWorkbook.Worksheets("Base de Datos").AutoFilter.Sort.SortFields.Clear
  28. ActiveWorkbook.Worksheets("Base de Datos").AutoFilter.Sort.SortFields.Add Key _
  29. :=Range("J1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
  30. xlSortNormal
  31. With ActiveWorkbook.Worksheets("Base de Datos").AutoFilter.Sort
  32. .Header = xlYes
  33. .MatchCase = False
  34. .Orientation = xlTopToBottom
  35. .SortMethod = xlPinYin
  36. .Apply
  37. End With
  38.  
  39. 'Seleccionar el resultado
  40. Range("A1").Select
  41. Selection.CurrentRegion.Select
  42.  
  43. 'Eliminar de la selección las
  44. 'dos últimas columnas
  45. Selection.Resize(, 8).Select
  46.  
  47. 'Copiar y pegar
  48. Selection.Copy
  49. Sheets("Consulta").Select
  50. Range("B12").Select
  51. ActiveSheet.Paste
  52. Range("B12").Select
  53.  
  54. 'Quitar la selección de las
  55. 'celdas copiadas
  56. Application.CutCopyMode = False
  57. End Sub
  58.  
  59.  

Proinf.net