Amélioration VBA
bonjour tout le monde,
je voulais savoir si on peut améliore cette macro qui est un peu longue en temps.
merci a vous
Sub MAJessai()
Application.ScreenUpdating = False
Cells(6, 4).Select
l = ActiveCell.Row
c = ActiveCell.Column
Do While l < 360
Range(Cells(l, 12), Cells(l, 27)).Select
Selection.Copy
l = l + 2
Cells(l, 12).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
l = l - 1
Range(Cells(l, 8), Cells(l, 11)).Select
Selection.Copy
l = l + 1
Cells(l, 8).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
l = l + 3
Loop
Cells(6, 4).Select
MsgBox ("ok")
End Sub
cordialement,
Bonjour,
Merci de joindre un fichier à ta demande et de nous expliquer l'objectif de la procédure.
Cdlt.
bonjour Jean-Eric
Je voulais juste savoir s' il était possible de l’accéléré n’étant pas un spécialiste
ci-dessous le code original, j'ai retirer l'essai avec ("Application.ScreenUpdating = False").
cordialement,
Sub MAJessai()
Cells(6, 4).Select
l = ActiveCell.Row
c = ActiveCell.Column
Do While l < 360
Range(Cells(l, 12), Cells(l, 27)).Select
Selection.Copy
l = l + 2
Cells(l, 12).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
l = l - 1
Range(Cells(l, 8), Cells(l, 11)).Select
Selection.Copy
l = l + 1
Cells(l, 8).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
l = l + 3 Loop
Cells(6, 4).Select
MsgBox ("ok")
End Sub
Bonjour,
Testes ce code mais je ne suis pas sûr qu'il remplisse ta demande donc sûrement à adapter mais de toutes façons, pour ne pas ralentir le code, il faut absolument éviter les sélections et autres activate :
Sub MAJessai()
Dim L As Long
Application.ScreenUpdating = False
Cells(6, 4).Select
L = 6
Do While L < 360
Range(Cells(L + 2, 12), Cells(L + 2, 27)).Value = Range(Cells(L, 12), Cells(L, 27)).Value
L = L + 1
Range(Cells(L + 1, 8), Cells(L + 1, 11)).Value = Range(Cells(L, 8), Cells(L, 11)).Value
L = L + 3
Loop
Application.ScreenUpdating = True
MsgBox ("ok")
End Subbonjour Theze,
merci d'avoir pris le temps,je fais un essai demain et te tiens au courant.
cordialement,
Bonjour afra, le forum,
Je propose ce code VBA (à tester) :
Option Explicit
Sub MAJessai()
Dim l&: Application.ScreenUpdating = False
For l = 6 To 360 Step 3
Range(Cells(l, 12), Cells(l, 27)).Copy
Cells(l + 2, 12).PasteSpecial -4163
Range(Cells(l + 1, 8), Cells(l + 1, 11)).Copy
Cells(l + 2, 8).PasteSpecial -4163
Next l
Application.CutCopyMode = False
[D6].Select: MsgBox "ok"
End Subdhany
bonjour Dhany,le forum
je test aujourd'hui et vous tiens au courant ce soir.
encore merci.
cordialement,
bonsoir,
un peu mieux
cordialement,