Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Boucle pour simplifier mon code: comment faire ?

Créer une discussion
  • Initiateur de la discussion Initiateur de la discussion LPandre
  • 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 !

S'inscrire
L

LPandre

XLDnaute Impliqué
Sur un autre post, je proposais de copier autant de fois que nécessaire ( en fonction du nombre de colonnes) un code donné.
Simplement par ce que je ne sais pas faire de boucle.
Comment remplacer le code ci dessous pour avoir une boite de dialogue qui demande "Première colonne ?" et je réponds F
Dernière colonne ? et je réponds H ( ou bien combien de colonnes avec F ? et je réponds 3)
et le code fait 3 fois la boucle des colonnes F à H
Ensuite, le code de copie des Dim et NBVAL , fait aussi 3 fois la boucle depuis la colonne A ( c'est toujours la A sur ma feuille réca 2)
Par avance merci.

***********
' copie des données de la feuille réca et suppression des cellules vides dans réca 2
Sheets("Réca").Select
Columns("F:F").Select
Selection.Copy
Sheets("Réca (2)").Select
Range("A1").Select
ActiveSheet.Paste
Selection.SpecialCells(xlCellTypeBlanks).Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp

Sheets("Réca").Select
Columns("G:G").Select
Selection.Copy
Sheets("Réca (2)").Select
Range("B1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.SpecialCells(xlCellTypeBlanks).Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp

Sheets("Réca").Select
Columns("H:H").Select
Selection.Copy
Sheets("Réca (2)").Select
Range("C1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.SpecialCells(xlCellTypeBlanks).Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp



' copie de la formule pour connaitre le nombre de valeurs de chaque colonne

Dim A As Long
A = Range("A65536").End(xlUp).Row
Range("A" & A + 1).Select
ActiveCell.FormulaLocal = "=NBVAL(A2:A" & A & ")"
Dim B As Long
B = Range("B65536").End(xlUp).Row
Range("B" & B + 1).Select
ActiveCell.FormulaLocal = "=NBVAL(B2:B" & B & ")"
Dim C As Long
C = Range("C65536").End(xlUp).Row
Range("C" & C + 1).Select
ActiveCell.FormulaLocal = "=NBVAL(C2:C" & C & ")"

**********
 
Trier par date Trier par votes
Re : Boucle pour simplifier mon code: comment faire ?

Bonjour,

voici une proposition, sans les Select, inutile (comme souvent):

Code: 
Sub test()
Dim Lig As Long, Nbre As String
Nbre = InputBox("Combien de colonne?")
If Nbre <> "" Then
For i = 6 To 6 + Nbre - 1
With Sheets("Réca (2)")
  Sheets("Réca").Columns(i).Copy .Columns(i - 5)
  .Columns(i - 5).SpecialCells(xlCellTypeBlanks).Delete
  Lig = .Cells(65536, i - 5).End(xlUp).Row
  .Cells(Lig + 1, i - 5).FormulaLocal = "=NBVAL(" & .Cells(1, i - 5).Address(0, 0) & ":" & .Cells(Lig, i - 5).Address(0, 0) & ")"
End With
Next
End If
End Sub

Edit: ajout du nombre de valeurs de chaque colonne
 
Dernière édition:
Vote positif 0 Vote négatif
Re : Boucle pour simplifier mon code: comment faire ?

Re : salut Skoobi et merci.

ça ne fonctionne pas comme je le souhaiterais.
je joins un fichier avec ma macro qui va bien mais qui est lourde de code et peu adaptative, et ta macro également dans le même module.


J'ai laissé à l'écran le résultat souhaité, mais tu n'as pas besoin de moi pour lancer une macro 🙂

De nouveau merci.
 

Pièces jointes

Vote positif 0 Vote négatif
Re : Boucle pour simplifier mon code: comment faire ?

Re,

Voici les modifications (en bleu):

Code: 
Sub test()
Dim Lig As Long, Nbre As String
' Nettoyage feuille réca 2
 
[B][COLOR=blue]Sheets("Réca (2)").Cells.Clear[/COLOR][/B]
    ' Boucle Skoobi :
 
Nbre = InputBox("Combien de colonne?")
If Nbre <> "" Then
For I = 6 To 6 + Nbre - 1
With Sheets("Réca (2)")
  Sheets("Réca").Columns(I).Copy .Columns(I - 5)
  .Columns(I - 5).SpecialCells(xlCellTypeBlanks).Delete [COLOR=blue][B]shift:=xlUp[/B][/COLOR]
  Lig = .Cells(65536, I - 5).End(xlUp).Row
  .Cells(Lig + 1, I - 5).FormulaLocal = "=NBVAL(" & .Cells(2, I - 5).Address(0, 0) & ":" & .Cells(Lig, I - 5).Address(0, 0) & ")"
End With
Next
End If
Range("A2").Select
End Sub

Edit: Ceci ne tient pas compte de ton mail de 15h11.
 
Dernière édition:
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- 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ésolu(e)
XL 2019 macro avec fonction copié coller si rempli par la macro
Réponses
12
Affichages
269
AtTheOne
  • Question Question
Autres fenêtre "Publication"
Réponses
10
Affichages
547
ph.vanne
T
  • Question Question
XL 2013 Impression, choix de feuilles et nombre de copie
Réponses
11
Affichages
487
AtTheOne
V
  • Question Question
XL 2016 transformer en boucle une macro créer avec l'enregistreur automatique
Réponses
3
Affichages
104
vazvaz
V
  • Question Question
XL 2016 copier valeur actuel
2
Réponses
18
Affichages
315
sylvanu
G
  • Question Question
XL 2019 Sélectionner un fichier pour mettre à jour une base de données
Réponses
3
Affichages
264
sylvanu
M
  • Question Question
XL 2019 La méthode select de la classe range a échoué
Réponses
4
Affichages
140
job75
U
  • Question Question
Autres [RÉSOLU] Compléter la macro mais comment et où?
Réponses
2
Affichages
240
un internaute
U
U
  • Question Question
Autres [RÉSOLU] macro à modifier
Réponses
1
Affichages
164
un internaute
U
R
  • Question Question
Microsoft 365 Import .txt au format date
Réponses
14
Affichages
293
dysorthographie
F
  • Question Question
Microsoft 365 Problème mémoire insuffisante
Réponses
5
Affichages
236
TooFatBoy
W
  • Résolu(e)
XL 2016 Placer mes photos dans la colonne A, [A3], [A4],etc, jusqu'en [A99] selon le prénom et le nom colonnes B et C
2
Réponses
26
Affichages
407
Webperegrino
W
B
  • Question Question
XL 2013 Comment trier les nom des feuilles et fusionner leur tableaux dans une une autre feuille ?
Réponses
10
Affichages
693
Compte Supprimé 979
C
N
  • Résolu(e)
XL 2021 comment faire recherche dans une colonne et ligne
Réponses
5
Affichages
522
job75
  • Question Question
Microsoft 365 VBA : copier les adresses
Réponses
7
Affichages
339
VBA_dev_Anne_Marie
  • Question Question
XL 2021 Code manufacturier et fabricant (Ram) suite projet en cours ( à tester s'il vous plait )
2 3
Réponses
42
Affichages
1 K
TooFatBoy
S
  • Résolu(e)
Microsoft 365 Boucle pour afficher et masquer des lignes
Réponses
12
Affichages
685
shf
S
N
  • Question Question
XL 2016 Code VBA pour envoi de mail avec pdf en piece jointe
Réponses
4
Affichages
605
Phil69970
R
  • Résolu(e)
XL 2019 creer une macro pour copier des info d un onglet a un autre dans le meme classeur
Réponses
4
Affichages
656
robpellan52
R
P
  • Question Question
XL 2021 Ajout/adaptation de code VBA sur feuille qui en contient déjà
Réponses
3
Affichages
156
Pierreavecunp
P
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…