Bonjour à tous,
Je débute en programmation, et j’utilise le coté pratique de l’enregistrement macro pour réaliser quelques petits codes. Cependant le code généré dans le cas présent est de très mauvaise qualité en termes d’efficacité et de lisibilité pour réaliser plusieurs boucles et copies successives.
Boucle 1
1) J’active la feuille « A » et je sélectionne et copie le tableau (T20 :AG99)
2) J’active la feuille « 1 » et je colle le tableau en A20.
3) Je lance une autre macro
4) Je copie les cellules (BA20 :BA99) en DF20
5) Je copie les cellules (BE17 😀A17) en DX1
Boucle 2
1) J’active la feuille « A » et je sélectionne et copie le tableau (AH20 :AU99)
2) J’active la feuille « 1 » et je colle le tableau en A20.
3) Je lance une autre macro
4) Je copie les cellules (BA20 :BA99) en DG20
5) Je copie les cellules (BE17 😀A17) en DX2
Boucle 3
1) J’active la feuille « A » et je sélectionne et copie le tableau (AV20 :BI99)
2) J’active la feuille « 1 » et je colle le tableau en A20.
3) Je lance une autre macro
4) Je copie les cellules (BA20 :BA99) en DH20
5) Je copie les cellules (BE17 😀A17) en DX3
Ce que j’essaye de réaliser, plutôt que d’avoir des lignes qui s’incrémentent au fil des boucles, serait d’avoir un code réduit et lisible car je n’arrive pas à sélectionner et copier les tableaux dans les cellules successives au fil des boucles.
Merci par avance
Je joins le code que j’ai réalisé.
Sub Macro1()
'Boucle 1
' selection du tableau
Sheets("A").Select
Range("T20:AG20").Select
Selection.AutoFill Destination:=Range("T20:AG99"), Type:=xlFillDefault
Range("T20:AG99").Select
Selection.Copy
' Active la feuille 1 et copie le tableau
Sheets("1").Select
Range("A20").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' LANCE MACRO
Application.Run "'essaienauto.xlsm'!Boucle14"
' copie les cellules (BA20:BA99) en DF20
Range("BA20").Select
Range("BA20:BA99").Select
Selection.Copy
Range("DF20").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' copie les cellules (BE17😀A17) en DX1
Range("BE17😀A17").Select
Application.CutCopyMode = False
Selection.Copy
Range("DX1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'****************************************************************'Boucle 2
' selection du tableau
Sheets("A").Select
Range("AH20:AU20").Select
Selection.AutoFill Destination:=Range("AH20:AU99"), Type:=xlFillDefault
Range("AH20:AU99").Select
Selection.Copy
' Active la feuille 1 et copie le tableau
Sheets("1").Select
Range("A20").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' LANCE MACRO
Application.Run "'essaienauto.xlsm'!Boucle14"
' copie les cellules (BA20:BA99) en DG20
Range("ba20").Select
Range("ba20:ba99").Select
Selection.Copy
Range("Dg20").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' copie les cellules (BE17😀A17) en DX2
Range("BE17😀A17").Select
Application.CutCopyMode = False
Selection.Copy
Range("DX2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'*****************************************************************'Boucle 3
' selection du tableau
Sheets("A").Select
Range("AV20:BI20").Select
Selection.AutoFill Destination:=Range("AV20:BI99"), Type:=xlFillDefault
Range("AV20:BI99").Select
Selection.Copy
' Active la feuille 1 et copie le tableau
Sheets("1").Select
Range("A20").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' LANCE MACRO
Application.Run "'essaienauto.xlsm'!Boucle14"
' copie les cellules (BA20:BA99) en DH20
Range("ba20").Select
Range("ba20:ba99").Select
Selection.Copy
Range("DH20").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' copie les cellules (BE17😀A17) en DX3
Range("BE17😀A17").Select
Application.CutCopyMode = False
Selection.Copy
Range("DX3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub
Je débute en programmation, et j’utilise le coté pratique de l’enregistrement macro pour réaliser quelques petits codes. Cependant le code généré dans le cas présent est de très mauvaise qualité en termes d’efficacité et de lisibilité pour réaliser plusieurs boucles et copies successives.
Boucle 1
1) J’active la feuille « A » et je sélectionne et copie le tableau (T20 :AG99)
2) J’active la feuille « 1 » et je colle le tableau en A20.
3) Je lance une autre macro
4) Je copie les cellules (BA20 :BA99) en DF20
5) Je copie les cellules (BE17 😀A17) en DX1
Boucle 2
1) J’active la feuille « A » et je sélectionne et copie le tableau (AH20 :AU99)
2) J’active la feuille « 1 » et je colle le tableau en A20.
3) Je lance une autre macro
4) Je copie les cellules (BA20 :BA99) en DG20
5) Je copie les cellules (BE17 😀A17) en DX2
Boucle 3
1) J’active la feuille « A » et je sélectionne et copie le tableau (AV20 :BI99)
2) J’active la feuille « 1 » et je colle le tableau en A20.
3) Je lance une autre macro
4) Je copie les cellules (BA20 :BA99) en DH20
5) Je copie les cellules (BE17 😀A17) en DX3
Ce que j’essaye de réaliser, plutôt que d’avoir des lignes qui s’incrémentent au fil des boucles, serait d’avoir un code réduit et lisible car je n’arrive pas à sélectionner et copier les tableaux dans les cellules successives au fil des boucles.
Merci par avance
Je joins le code que j’ai réalisé.
Sub Macro1()
'Boucle 1
' selection du tableau
Sheets("A").Select
Range("T20:AG20").Select
Selection.AutoFill Destination:=Range("T20:AG99"), Type:=xlFillDefault
Range("T20:AG99").Select
Selection.Copy
' Active la feuille 1 et copie le tableau
Sheets("1").Select
Range("A20").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' LANCE MACRO
Application.Run "'essaienauto.xlsm'!Boucle14"
' copie les cellules (BA20:BA99) en DF20
Range("BA20").Select
Range("BA20:BA99").Select
Selection.Copy
Range("DF20").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' copie les cellules (BE17😀A17) en DX1
Range("BE17😀A17").Select
Application.CutCopyMode = False
Selection.Copy
Range("DX1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'****************************************************************'Boucle 2
' selection du tableau
Sheets("A").Select
Range("AH20:AU20").Select
Selection.AutoFill Destination:=Range("AH20:AU99"), Type:=xlFillDefault
Range("AH20:AU99").Select
Selection.Copy
' Active la feuille 1 et copie le tableau
Sheets("1").Select
Range("A20").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' LANCE MACRO
Application.Run "'essaienauto.xlsm'!Boucle14"
' copie les cellules (BA20:BA99) en DG20
Range("ba20").Select
Range("ba20:ba99").Select
Selection.Copy
Range("Dg20").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' copie les cellules (BE17😀A17) en DX2
Range("BE17😀A17").Select
Application.CutCopyMode = False
Selection.Copy
Range("DX2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'*****************************************************************'Boucle 3
' selection du tableau
Sheets("A").Select
Range("AV20:BI20").Select
Selection.AutoFill Destination:=Range("AV20:BI99"), Type:=xlFillDefault
Range("AV20:BI99").Select
Selection.Copy
' Active la feuille 1 et copie le tableau
Sheets("1").Select
Range("A20").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' LANCE MACRO
Application.Run "'essaienauto.xlsm'!Boucle14"
' copie les cellules (BA20:BA99) en DH20
Range("ba20").Select
Range("ba20:ba99").Select
Selection.Copy
Range("DH20").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' copie les cellules (BE17😀A17) en DX3
Range("BE17😀A17").Select
Application.CutCopyMode = False
Selection.Copy
Range("DX3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub