Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.
  • Initiateur de la discussion Initiateur de la discussion pascal82
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

pascal82

XLDnaute Occasionnel
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
 
Re : Programme VBA

Bonjour,
Le début :
Code:
Sheets("A").Range("T20:AG99").Copy
Sheets("1").Range("A20").PasteSpecial Paste:=xlPasteValues
Pour que tu progresses, je te laisse faire des essais pour la suite.
Mets le moins possible de Select (ça ralentit)
Pour consulter l'aide et obtenir la syntaxe utilise la touche F1 ,le curseur étant sur la propriété qui t'intéresse (ici Copy et PasteSpecial).
Bonne persévérance.
A+
 
Re : Programme VBA

Bonjour Hippolite,

J’ai suivi tes conseils, miracle ça fonctionne beaucoup mieux et le code est largement plus clair qu’avant. Par contre cela ne résout pas encore mon problème de boucles. Si la formation pouvait continuer, je suis preneur.

Merci par avance
PHP:
Sub Macro1()
'Boucle 1
'Selection et copie du tableau
    Sheets("A").Range("T20:AG20").Copy
    Sheets("1").Range("A20").PasteSpecial Paste:=xlPasteValues
 ' LANCE MACRO
  Application.Run "'essaienauto.xlsm'!Boucle14"
'Selection et copie des cellules (BA20:BA99) en DF20
    Range("BA20:BA99").Copy
    Range("DF20").PasteSpecial Paste:=xlPasteValues
'Selection et copie des cellules (BE17:DA17) en DX1
    Range("BE17:DA17").Copy
    Range("DX1").PasteSpecial Paste:=xlPasteValues

  '*******************************************************************
'Boucle 2
'Selection et copie du tableau
    Sheets("A").Range("AH20:AU20").Copy
    Sheets("1").Range("A20").PasteSpecial Paste:=xlPasteValues
' LANCE MACRO
    Application.Run "'essaienauto.xlsm'!Boucle14"
'Selection et copie des cellules (BA20:BA99) en DG20
    Range("BA20:BA99").Copy
    Range("DG20").PasteSpecial Paste:=xlPasteValues
'Selection et copie des cellules (BE17:DA17) en DX2
    Range("BE17:DA17").Copy
    Range("DX2").PasteSpecial Paste:=xlPasteValues

'***********************************************************************
'Boucle 3
'Selection et copie du tableau
    Sheets("A").Range("AV20:BI20").Copy
    Sheets("1").Range("A20").PasteSpecial Paste:=xlPasteValues
' LANCE MACRO
    Application.Run "'essaienauto.xlsm'!Boucle14"
'Selection et copie des cellules (BA20:BA99) en DH20
    Range("BA20:BA99").Copy
    Range("DH20").PasteSpecial Paste:=xlPasteValues
'Selection et copie des cellules (BE17:DA17) en DX3
    Range("BE17:DA17").Copy
    Range("DX3").PasteSpecial Paste:=xlPasteValues

   End Sub
 
Dernière édition:
Re : Programme VBA

Re,
Ton code a une présentation difficile à lire, modifie ton message avec "modifier le message" et insère les balises de code qui sont dans ma signature. En prévisualisation, tu verras tout de suite si tu y es parvenu ( à défaut il y a aussi le bouton # qui crée des balises code mais sans couleur)
A+
 
Re : Programme VBA

Re,
Tu as fait une petite erreur c'est highlight=VBA et non PHP
VB:
Sub Macro1()
  Application.ScreenUpdating = False
  For i = 1 To 3
    decal = 14 * i
    Sheets("A").Range("F20:S20").Offset(0, decal).Copy
    Sheets("1").Activate
    Range("A20").PasteSpecial Paste:=xlPasteValues
    Application.Run "'essaienauto.xlsm'!Boucle14"
    Range("BA20:BA99").Copy
    Range("DE20").Offset(0, i).PasteSpecial Paste:=xlPasteValues
    Range("BE17:DA17").Copy
    Range("DX1").Offset(i - 1, 0).PasteSpecial Paste:=xlPasteValues
  Next i
  Application.ScreenUpdating = True
End Sub
Je te laisse approfondir :
Offset : rapide et utile pour décaler des cellules par rapport à une référence
ScreenUpdating : gel de l'affichage de l'écran

A+
 
Re : Programme VBA

Merci encore,

Le code fonctionne à merveille, j’ai juste modifié la référence du tableau (F20:AG99).

A+

Code:
For I = 1 To 3
    decal = 14 * I
    Sheets("A").Range("F20:AG99").Offset(0, decal).Copy
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
10
Affichages
792
Réponses
18
Affichages
597
Réponses
2
Affichages
400
Réponses
17
Affichages
1 K
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…