Optimizar codigo

exskizzo · el 14 de agosto

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.

Gerson Pineda · el 14 de agosto

@[uSER=76522]exskizzo[/uSER] no eres nuevo en el foro, porfavor envuelve los codigos con ETIQUETAS, ahora lo hice por ti

Saludos

elunico22 · el 14 de agosto

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