Saltar al contenido

Optimizar codigo

publicado

Buenos dias.

Le anexo mi codigo, y espero y me puedan ayudar a minimizarlo ya que cuenta con muchas lineas, y es lento.

Function IsFileOpen(filename As String)

  Dim filenum As Integer, errnum As Integer

  On Error Resume Next

  filenum = FreeFile()

  Open filename For Input Lock Read As #filenum

  Close filenum

  errnum = Err

  On Error GoTo 0


  Select Case errnum


  Case 0

  IsFileOpen = False


  Case 70

  IsFileOpen = True


  Case Else

  Error errnum

  End Select

End Function

Sub copiar_a_Datos()

Application.ScreenUpdating = False

Dim Celda As Range

Dim palabra As String

Dim Libro As String

Dim wb As Object

  Libro = "I:\Respaldo 28-09-2012\PROGRAMACION\DATOS.xlsm" 'AQUI COLOCAR LA RUTA DEL LIBRO

ActiveSheet.Select

  Set E14 = ActiveSheet.Range("E14")

  Set E15 = ActiveSheet.Range("E15")

  Set E16 = ActiveSheet.Range("E16")

  Set E17 = ActiveSheet.Range("E17")

  Set E18 = ActiveSheet.Range("E18")

  Set E19 = ActiveSheet.Range("E19")

  Set E20 = ActiveSheet.Range("E20")

  Set E21 = ActiveSheet.Range("E21")

  Set E22 = ActiveSheet.Range("E22")

  Set E23 = ActiveSheet.Range("E23")

  Set E24 = ActiveSheet.Range("E24")

  Set E25 = ActiveSheet.Range("E25")

  Set E26 = ActiveSheet.Range("E26")

''''''''''''''''''''''''''''''''''''''''''''''''''''''

  Set N14 = ActiveSheet.Range("N14")

  Set N15 = ActiveSheet.Range("N15")

  Set N16 = ActiveSheet.Range("N16")

  Set N17 = ActiveSheet.Range("N17")

  Set N18 = ActiveSheet.Range("N18")

  Set N19 = ActiveSheet.Range("N19")

  Set N20 = ActiveSheet.Range("N20")

  Set N21 = ActiveSheet.Range("N21")

  Set N22 = ActiveSheet.Range("N22")

  Set N23 = ActiveSheet.Range("N23")

  Set N24 = ActiveSheet.Range("N24")

  Set N25 = ActiveSheet.Range("N25")

  Set N26 = ActiveSheet.Range("N26")

''''''''''''''''''''''''''''''''''''''''''''''''''''''

  Set K14 = ActiveSheet.Range("K14")

  Set K15 = ActiveSheet.Range("K15")

  Set K16 = ActiveSheet.Range("K16")

  Set K17 = ActiveSheet.Range("K17")

  Set K18 = ActiveSheet.Range("K18")

  Set K19 = ActiveSheet.Range("K19")

  Set K20 = ActiveSheet.Range("K20")

  Set K21 = ActiveSheet.Range("K21")

  Set K22 = ActiveSheet.Range("K22")

  Set K23 = ActiveSheet.Range("K23")

  Set K24 = ActiveSheet.Range("K24")

  Set K25 = ActiveSheet.Range("K25")

  Set K26 = ActiveSheet.Range("K26")

''''''''''''''''''''''''''''''''''''''''''''''''''''''

  Set I14 = ActiveSheet.Range("I14")

  Set I15 = ActiveSheet.Range("I15")

  Set I16 = ActiveSheet.Range("I16")

  Set I17 = ActiveSheet.Range("I17")

  Set I18 = ActiveSheet.Range("I18")

  Set I19 = ActiveSheet.Range("I19")

  Set I20 = ActiveSheet.Range("I20")

  Set I21 = ActiveSheet.Range("I21")

  Set I22 = ActiveSheet.Range("I22")

  Set I23 = ActiveSheet.Range("I23")

  Set I24 = ActiveSheet.Range("I24")

  Set I25 = ActiveSheet.Range("I25")

  Set I26 = ActiveSheet.Range("I26")

''''''''''''''''''''''''''''''''''''''''''''''''''''''

  Set AV14 = ActiveSheet.Range("AV14")

  Set AV15 = ActiveSheet.Range("AV15")

  Set AV16 = ActiveSheet.Range("AV16")

  Set AV17 = ActiveSheet.Range("AV17")

  Set AV18 = ActiveSheet.Range("AV18")

  Set AV19 = ActiveSheet.Range("AV19")

  Set AV20 = ActiveSheet.Range("AV20")

  Set AV21 = ActiveSheet.Range("AV21")

  Set AV22 = ActiveSheet.Range("AV22")

  Set AV23 = ActiveSheet.Range("AV23")

  Set AV24 = ActiveSheet.Range("AV24")

  Set AV25 = ActiveSheet.Range("AV25")

  Set AV26 = ActiveSheet.Range("AV26")

''''''''''''''''''''''''''''''''''''''''''''''''''''''

  Set AB14 = ActiveSheet.Range("AB14")

  Set AB15 = ActiveSheet.Range("AB15")

  Set AB16 = ActiveSheet.Range("AB16")

  Set AB17 = ActiveSheet.Range("AB17")

  Set AB18 = ActiveSheet.Range("AB18")

  Set AB19 = ActiveSheet.Range("AB19")

  Set AB20 = ActiveSheet.Range("AB20")

  Set AB21 = ActiveSheet.Range("AB21")

  Set AB22 = ActiveSheet.Range("AB22")

  Set AB23 = ActiveSheet.Range("AB23")

  Set AB24 = ActiveSheet.Range("AB24")

  Set AB25 = ActiveSheet.Range("AB25")

  Set AB26 = ActiveSheet.Range("AB26")

''''''''''''''''''''''''''''''''''''''''''''''''''''''

  Set T30 = ActiveSheet.Range("T30")

  Set T31 = ActiveSheet.Range("T31")

  Set T32 = ActiveSheet.Range("T32")

  Set T33 = ActiveSheet.Range("T33")

  Set T34 = ActiveSheet.Range("T34")

  Set T35 = ActiveSheet.Range("T35")

''''''''''''''''''''''''''''''''''''''''''''''''''''''

  Set W30 = ActiveSheet.Range("W30")

  Set W31 = ActiveSheet.Range("W31")

  Set W32 = ActiveSheet.Range("W32")

  Set W33 = ActiveSheet.Range("W33")

  Set W34 = ActiveSheet.Range("W34")

  Set W35 = ActiveSheet.Range("W35")

'''''''''''''''''''''''''''''''''''''''''''

  Set L2 = ActiveSheet.Range("L2")

  Set M2 = ActiveSheet.Range("M2")

  Set N2 = ActiveSheet.Range("N2")

  Set O2 = ActiveSheet.Range("O2")

  Set P2 = ActiveSheet.Range("P2")

  Set Q2 = ActiveSheet.Range("Q2")

  Set R2 = ActiveSheet.Range("R2")

  Set S2 = ActiveSheet.Range("S2")

  Set T2 = ActiveSheet.Range("T2")

  Set U2 = ActiveSheet.Range("U2")

  Set V2 = ActiveSheet.Range("V2")

  Set P5 = ActiveSheet.Range("P5")


If IsFileOpen("I:\Respaldo 28-09-2012\PROGRAMACION\DATOS.xlsm") Then

  MsgBox "El Archivo solicitado esta en uso, debes cerrarlo"

  Exit Sub

Else

Workbooks.Open Libro, Password:=6230

Set wb = Workbooks(Workbooks.Count)


  ActiveSheet.Range("D1").Activate

  Do While Not IsEmpty(ActiveCell)

  ActiveCell.Offset(1, 0).Activate

  Loop


  With ActiveCell

  ''Procesos'''''''''''''''''

  .Offset(0, -2).Value = P5

  .Offset(0, 0).Value = E14

  .Offset(0, 2).Value = E15

  .Offset(0, 4).Value = E16

  .Offset(0, 6).Value = E17

  .Offset(0, 8).Value = E18

  .Offset(0, 10).Value = E19

  .Offset(0, 12).Value = E20

  .Offset(0, 14).Value = E21

  .Offset(0, 16).Value = E22

  .Offset(0, 18).Value = E23

  .Offset(0, 20).Value = E24

  .Offset(0, 22).Value = E25

  .Offset(0, 24).Value = E26

  ''Materiales''''''''''''''''

  .Offset(0, 1).Value = N14

  .Offset(0, 3).Value = N15

  .Offset(0, 5).Value = N16

  .Offset(0, 7).Value = N17

  .Offset(0, 9).Value = N18

  .Offset(0, 11).Value = N19

  .Offset(0, 13).Value = N20

  .Offset(0, 15).Value = N21

  .Offset(0, 17).Value = N22

  .Offset(0, 19).Value = N23

  .Offset(0, 21).Value = N24

  .Offset(0, 23).Value = N25

  .Offset(0, 25).Value = N26

  ''Decimetrajes''''''''''''''

  .Offset(0, 44).Value = K14

  .Offset(0, 46).Value = K15

  .Offset(0, 48).Value = K16

  .Offset(0, 50).Value = K17

  .Offset(0, 52).Value = K18

  .Offset(0, 54).Value = K19

  .Offset(0, 56).Value = K20

  .Offset(0, 58).Value = K21

  .Offset(0, 60).Value = K22

  .Offset(0, 62).Value = K23

  .Offset(0, 64).Value = K24

  .Offset(0, 66).Value = K25

  .Offset(0, 68).Value = K26

  ''Consumos''''''''''''''''''

  .Offset(0, 43).Value = I14

  .Offset(0, 45).Value = I15

  .Offset(0, 47).Value = I16

  .Offset(0, 49).Value = I17

  .Offset(0, 51).Value = I18

  .Offset(0, 53).Value = I19

  .Offset(0, 55).Value = I20

  .Offset(0, 57).Value = I21

  .Offset(0, 59).Value = I22

  .Offset(0, 61).Value = I23

  .Offset(0, 63).Value = I24

  .Offset(0, 65).Value = I25

  .Offset(0, 67).Value = I26

  ''Consumos Conversion'''''''

  .Offset(0, 70).Value = AB14

  .Offset(0, 71).Value = AB15

  .Offset(0, 72).Value = AB16

  .Offset(0, 73).Value = AB17

  .Offset(0, 74).Value = AB18

  .Offset(0, 75).Value = AB19

  .Offset(0, 76).Value = AB20

  .Offset(0, 77).Value = AB21

  .Offset(0, 78).Value = AB22

  .Offset(0, 79).Value = AB23

  .Offset(0, 80).Value = AB24

  .Offset(0, 81).Value = AB25

  .Offset(0, 82).Value = AB26

  ''Nombre de Avios'''''''''''

  .Offset(0, 26).Value = T30

  .Offset(0, 28).Value = T31

  .Offset(0, 30).Value = T32

  .Offset(0, 32).Value = T33

  .Offset(0, 34).Value = T34

  .Offset(0, 36).Value = T35

  ''Avios'''''''''''''''''''''

  .Offset(0, 27).Value = W30

  .Offset(0, 29).Value = W31

  .Offset(0, 31).Value = W32

  .Offset(0, 33).Value = W33

  .Offset(0, 35).Value = W34

  .Offset(0, 37).Value = W35

  ''Corrida'''''''''''''''''''

  .Offset(0, 83).Value = L2

  .Offset(0, 84).Value = M2

  .Offset(0, 85).Value = N2

  .Offset(0, 86).Value = O2

  .Offset(0, 87).Value = P2

  .Offset(0, 88).Value = Q2

  .Offset(0, 89).Value = R2

  .Offset(0, 90).Value = S2

  .Offset(0, 91).Value = T2

  .Offset(0, 92).Value = U2

  .Offset(0, 93).Value = V2

  End With

End If

'''''''''''''''''''''''''''''''''''''''''''''''''


wb.Save

wb.Close

Application.ScreenUpdating = True

End Sub[/CODE]

Ojala y me puedan ayudar a optimizar este codigo, ya que tiene demaciadas lineas y es muy lento.

Gracias y quedo en espera de su ayuda.

Featured Replies

publicado

Hola:

Serviria si colocaras tu archivo el cual tiene ese codigo de acuerdo a las normas de foro y ademas que explicaras lo que deseas que haga el codigo. Quizas se pueda replantear.

Saludos

publicado
  • Autor

Gracias Gerson Pineda.

Me vas a creer que no encontre las etiquetas.

De cualquier manera gracias y una disculpa.

publicado
  • Autor

Tienes razon elunico22.

Lo que hace dicho codigo es lo siguiente:

1.- Tengo una funcion, con la cual trabajo para que me detecte si el libro a donde envio la informacion esta abierto o no.

2.- Enseguida la macro recoge informacion (Celdas definidas en la macro) del libro en uso y la envia al libro destino que lo llame "Datos".

Agrosomodo es todo lo que hace la macro.

Quedo en espera de sus comentarios.

COSTOS MODAMA PV 2014.rar

Archivado

Este tema está ahora archivado y está cerrado a más respuestas.

Ir al listado de temas