XL 2016 macro avec boucle

B

benbella1991

XLDnaute Nouveau
Bonjour la famille, j'espère que vous allez bien;)

Je sollicite vraiment votre aide, j'ai pu enregistrer une macro qui me permet de récupérer les données d'un page et les transférer dans d'autres (avec quelques petits xls).
Bien-sûr je l'ai effectué sur une feuille et ensuite j'ai ajouté une boucle pour faire tourner sur un certain nombre feuilles.

Cependant, la macro est fonctionnelle sur toutes les feuilles pour le premier lancement, mais après elle ne fonctionne que pour la feuille active.

Voici la macro:

Sub A_Semaine_Suivante()
Dim Ws As Worksheet

' Semaine_Suivante Macro
'
For Each Ws In Worksheets

Range("C10").Select

'formule recherche v

ActiveCell.FormulaR1C1 = _
"=+IFERROR(VLOOKUP(RC2,'SUIVI TRAVAUX'!C2:C31,2,FALSE),)"
Range("C10").Select
Selection.AutoFill Destination:=Range("C10:C18"), Type:=xlFillDefault
Range("C10:C18").Select
Range("C10").Select
Selection.Copy
Range("D10").Select
ActiveSheet.Paste

Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = _
"=+IFERROR(VLOOKUP(RC2,'SUIVI TRAVAUX'!C2:C31,3,FALSE),)"
Range("D10").Select
Selection.AutoFill Destination:=Range("D10:D18"), Type:=xlFillDefault
Range("D10:D18").Select
Range("D10").Select
Selection.Copy
Range("F10").Select
ActiveSheet.Paste

Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = _
"=+IFERROR(VLOOKUP(RC2,'SUIVI TRAVAUX'!C2:C31,29,FALSE),)"
Range("F10").Select
Selection.AutoFill Destination:=Range("F10:F18"), Type:=xlFillDefault
Range("F10:F18").Select
Range("J10:J18,L10:L18").Select
Range("L10").Activate
Selection.ClearContents
Range("C10:D18,F10:F18").Select
Range("F10").Activate
Selection.Copy
Range("C10:D18").Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("F10:F18").Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("F20").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = ""
Range("D20").Select

If Ws.Name = "RECAPITULATIF" Then Exit For


Next Ws

End Sub

Please, help me!!!!
 
Solution
Phil69970
@benbella1991 et @ERIC S

Sur la version plus courte du post #6 j'ai oublié des guillemets.... """ dans la la formule pour si erreur ;)
Erreur corrigée ... 🤣

VB: 
Sub A_Semaine_Suivante()
Dim Ws As Worksheet
For Each Ws In Worksheets
    If Ws.Name <> "RECAPITULATIF" Then
        With Ws
            .[C10:C18].FormulaLocal = "=SIERREUR(RECHERCHEV($B10;'SUIVI TRAVAUX'!$B:$AE;2;FAUX);"""")"
            .[C10:C18] = .[C10:C18].Value
           
            .[D10:D18].FormulaLocal = "=SIERREUR(RECHERCHEV($B10;'SUIVI TRAVAUX'!$B:$AE;2;FAUX);"""")"
            .[D10:D18] = .[D10:D18].Value
           
            .[F10:F18].FormulaLocal = "=SIERREUR(RECHERCHEV($B10;'SUIVI TRAVAUX'!$B:$AE;2;FAUX);"""")"
            .[F10:F18] =...
Trier par date Trier par votes
ERIC S

ERIC S

XLDnaute Barbatruc
Bonjour

for each WS in worksheet
with ws
.range("C10:C18").formulaR1C1="=+IFERROR(VLOOKUP(RC2,'SUIVI TRAVAUX'!C2:C31,2,FALSE),)"
.range("F10:F18").formulaR1C1="=+IFERROR(VLOOKUP(RC2,'SUIVI TRAVAUX'!C2:C31,3,FALSE),)"
...
end with
next
 
Vote positif 0 Vote négatif
Phil69970

Phil69970

XLDnaute Barbatruc
Bonjour @benbella1991 @ERIC S

@benbella1991
Je te propose ceci :

VB: 
Sub A_Semaine_Suivante()
Dim Ws As Worksheet
For Each Ws In Worksheets
    If Ws.Name <> "RECAPITULATIF" Then
        With Ws
            .[C10].FormulaLocal = "=SIERREUR(RECHERCHEV($B10;'SUIVI TRAVAUX'!$B:$AE;2;FAUX);"""")"
            .[C10].AutoFill Destination:=.[C10:C18], Type:=xlFillDefault
            .[C10:C18] = .[C10:C18].Value
            
            .[D10].FormulaLocal = "=SIERREUR(RECHERCHEV($B10;'SUIVI TRAVAUX'!$B:$AE;2;FAUX);"""")"
            .[D10].AutoFill Destination:=.[D10:D18], Type:=xlFillDefault
            .[D10:D18] = .[D10:D18].Value
            
            .[F10].FormulaLocal = "=SIERREUR(RECHERCHEV($B10;'SUIVI TRAVAUX'!$B:$AE;2;FAUX);"""")"
            .[F10].AutoFill Destination:=.[F10:F18], Type:=xlFillDefault
            .[F10:F18] = .[F10:F18].Value
        
            .Range("J10:J18,L10:L18,F20").ClearContents
        End With
    End If
Next

End Sub

Merci de ton retour

@Phil69970
 
Vote positif 0 Vote négatif
Phil69970

Phil69970

XLDnaute Barbatruc
@benbella1991

Phil69970 à dit:
Merci de ton retour
Cliquez pour agrandir...
Pas de retour ? o_O

1659514207739.png


Pas cool, c'est sur ça donne envie pour la prochaine fois ;)

@Phil69970
 
Vote positif 0 Vote négatif
Phil69970

Phil69970

XLDnaute Barbatruc
@benbella1991

Et on peut même faire un peu plus court comme le suggere Eric et gagner 3 lignes o_O

VB: 
Sub A_Semaine_Suivante()
Dim Ws As Worksheet
For Each Ws In Worksheets
    If Ws.Name <> "RECAPITULATIF" Then
        With Ws
            .[C10:C18].FormulaLocal = "=SIERREUR(RECHERCHEV($B10;'SUIVI TRAVAUX'!$B:$AE;2;FAUX);)"
            .[C10:C18] = .[C10:C18].Value
            
            .[D10:D18].FormulaLocal = "=SIERREUR(RECHERCHEV($B10;'SUIVI TRAVAUX'!$B:$AE;2;FAUX);)"
            .[D10:D18] = .[D10:D18].Value
            
            .[F10:F18].FormulaLocal = "=SIERREUR(RECHERCHEV($B10;'SUIVI TRAVAUX'!$B:$AE;2;FAUX);)"
            .[F10:F18] = .[F10:F18].Value
        
            .Range("J10:J18,L10:L18,F20").ClearContents
        End With
    End If
Next
End Sub

Merci de ton retour

@Phil69970
 
Vote positif 0 Vote négatif
ERIC S

ERIC S

XLDnaute Barbatruc
Phil69970 à dit:
@benbella1991

Et on peut même faire un peu plus court comme le suggere Eric et gagner 3 lignes o_O

VB: 
Sub A_Semaine_Suivante()
Dim Ws As Worksheet
For Each Ws In Worksheets
    If Ws.Name <> "RECAPITULATIF" Then
        With Ws
            .[C10:C18].FormulaLocal = "=SIERREUR(RECHERCHEV($B10;'SUIVI TRAVAUX'!$B:$AE;2;FAUX);)"
            .[C10:C18] = .[C10:C18].Value
           
            .[D10:D18].FormulaLocal = "=SIERREUR(RECHERCHEV($B10;'SUIVI TRAVAUX'!$B:$AE;2;FAUX);)"
            .[D10:D18] = .[D10:D18].Value
           
            .[F10:F18].FormulaLocal = "=SIERREUR(RECHERCHEV($B10;'SUIVI TRAVAUX'!$B:$AE;2;FAUX);)"
            .[F10:F18] = .[F10:F18].Value
       
            .Range("J10:J18,L10:L18,F20").ClearContents
        End With
    End If
Next
End Sub

Merci de ton retour

@Phil69970
Cliquez pour agrandir...

Bonjour PHIL, j'étais juste en train de te poser la question, comme hier j'avais fait cela de tête....
J'ai ma réponse ;)
 
Vote positif 0 Vote négatif
Phil69970

Phil69970

XLDnaute Barbatruc
@benbella1991 et @ERIC S

Sur la version plus courte du post #6 j'ai oublié des guillemets.... """ dans la la formule pour si erreur ;)
Erreur corrigée ... 🤣

VB: 
Sub A_Semaine_Suivante()
Dim Ws As Worksheet
For Each Ws In Worksheets
    If Ws.Name <> "RECAPITULATIF" Then
        With Ws
            .[C10:C18].FormulaLocal = "=SIERREUR(RECHERCHEV($B10;'SUIVI TRAVAUX'!$B:$AE;2;FAUX);"""")"
            .[C10:C18] = .[C10:C18].Value
           
            .[D10:D18].FormulaLocal = "=SIERREUR(RECHERCHEV($B10;'SUIVI TRAVAUX'!$B:$AE;2;FAUX);"""")"
            .[D10:D18] = .[D10:D18].Value
           
            .[F10:F18].FormulaLocal = "=SIERREUR(RECHERCHEV($B10;'SUIVI TRAVAUX'!$B:$AE;2;FAUX);"""")"
            .[F10:F18] = .[F10:F18].Value
       
            .Range("J10:J18,L10:L18,F20").ClearContents
        End With
    End If
Next
End Sub

Merci de ton retour

@Phil69970
 
Vote positif 0 Vote négatif
Solution
B

benbella1991

XLDnaute Nouveau
Phil69970 à dit:
Bonjour @benbella1991 @ERIC S

@benbella1991
Je te propose ceci :

VB: 
Sub A_Semaine_Suivante()
Dim Ws As Worksheet
For Each Ws In Worksheets
    If Ws.Name <> "RECAPITULATIF" Then
        With Ws
            .[C10].FormulaLocal = "=SIERREUR(RECHERCHEV($B10;'SUIVI TRAVAUX'!$B:$AE;2;FAUX);"""")"
            .[C10].AutoFill Destination:=.[C10:C18], Type:=xlFillDefault
            .[C10:C18] = .[C10:C18].Value
           
            .[D10].FormulaLocal = "=SIERREUR(RECHERCHEV($B10;'SUIVI TRAVAUX'!$B:$AE;2;FAUX);"""")"
            .[D10].AutoFill Destination:=.[D10:D18], Type:=xlFillDefault
            .[D10:D18] = .[D10:D18].Value
           
            .[F10].FormulaLocal = "=SIERREUR(RECHERCHEV($B10;'SUIVI TRAVAUX'!$B:$AE;2;FAUX);"""")"
            .[F10].AutoFill Destination:=.[F10:F18], Type:=xlFillDefault
            .[F10:F18] = .[F10:F18].Value
       
            .Range("J10:J18,L10:L18,F20").ClearContents
        End With
    End If
Next

End Sub

Merci de ton retour

@Phil69970
Cliquez pour agrandir...

OK j'ai lancé la macro telle que présentée, cependant la macro bloque:
la ligne suivante (ligne 4 du code) ----- If Ws.Name <> "RECAPITULATIF" Then -----
traduit le fait que toutes les feuilles sont concernées, sauf RECAPITULATIF.

Or, dans mon code originel, j'avais marqué que ----- If Ws.Name = "RECAPITULATIF" Then Exit For----- pour dire que, si la feuille RECAPITULATIF est atteinte, sortir de la boucle (les feuilles étant rangées dans un ordre, la feuille RECAPITULATIF est la première des quatre dernières feuilles que je ne veux pas modifier).


Donc je modifierai cette ligne et je verrai ce que ça donne
 
Vote positif 0 Vote négatif
B

benbella1991

XLDnaute Nouveau
Phil69970 à dit:
@benbella1991 et @ERIC S

Sur la version plus courte du post #6 j'ai oublié des guillemets.... """ dans la la formule pour si erreur ;)
Erreur corrigée ... 🤣

VB: 
Sub A_Semaine_Suivante()
Dim Ws As Worksheet
For Each Ws In Worksheets
    If Ws.Name <> "RECAPITULATIF" Then
        With Ws
            .[C10:C18].FormulaLocal = "=SIERREUR(RECHERCHEV($B10;'SUIVI TRAVAUX'!$B:$AE;2;FAUX);"""")"
            .[C10:C18] = .[C10:C18].Value
          
            .[D10:D18].FormulaLocal = "=SIERREUR(RECHERCHEV($B10;'SUIVI TRAVAUX'!$B:$AE;2;FAUX);"""")"
            .[D10:D18] = .[D10:D18].Value
          
            .[F10:F18].FormulaLocal = "=SIERREUR(RECHERCHEV($B10;'SUIVI TRAVAUX'!$B:$AE;2;FAUX);"""")"
            .[F10:F18] = .[F10:F18].Value
      
            .Range("J10:J18,L10:L18,F20").ClearContents
        End With
    End If
Next
End Sub

Merci de ton retour

@Phil69970
Cliquez pour agrandir...
C'est pareil, je vais changer la ligne 4 et je vous reviens
 
Vote positif 0 Vote négatif
Phil69970

Phil69970

XLDnaute Barbatruc
@benbella1991

Habituellement on veut boucler sur toutes les feuilles sauf la feuille X et/ou Y qui est la feuille accueil ou récap ou bien paramètre par exemple .....
Autrement fourni ton fichier avec l'explication de ce que tu veux.

la feuille RECAPITULATIF est la première des quatre dernières feuilles que je ne veux pas modifier).
Cliquez pour agrandir...
Donne le nom de tes 4 feuilles que tu ne veux pas traiter et on les exclura tu traitement.
Avantage tu pourras mettre tes feuille dans n'importe quel ordre... ;)


@Phil69970
 
Dernière édition:
Vote positif 0 Vote négatif
Phil69970

Phil69970

XLDnaute Barbatruc
@benbella1991

Tu remplaces la ligne

If Ws.Name <> "RECAPITULATIF" Then
Cliquez pour agrandir...
par :

If Ws.Name <> "RECAPITULATIF" And Ws.Name <> "Pas touche1" And Ws.Name <> "Pas touche2" And _
Ws.Name <> "Pas touche3" And Ws.Name <> "Pas touche4" Then
Cliquez pour agrandir...

Évidement
==> Pas touche1 est le nom de ta 1ere feuille que tu veux exclure à adapter
==> Pas touche2 est le nom de ta 2eme feuille que tu veux exclure à adapter
==> Pas touche3 est le nom de ta 3eme feuille que tu veux exclure à adapter
==> Pas touche4 est le nom de ta 4eme feuille que tu veux exclure à adapter
==> RECAPITULATIF est le nom de ta 5eme feuille que tu veux exclure

Merci de ton retour

@Phil69970
 
Vote positif 0 Vote négatif
B

benbella1991

XLDnaute Nouveau
Chers @Phil69970 et @ERIC S

OK j'ai lancé la macro telle que présentée, cependant la macro bloque:
la ligne suivante (ligne 4 du code) ----- If Ws.Name <> "RECAPITULATIF" Then -----
traduit le fait que toutes les feuilles sont concernées, sauf RECAPITULATIF.

Or, dans mon code originel, j'avais marqué que ----- If Ws.Name = "RECAPITULATIF" Then Exit For----- pour dire que, si la feuille RECAPITULATIF est atteinte, sortir de la boucle (les feuilles étant rangées dans un ordre, la feuille RECAPITULATIF est la première des quatre dernières feuilles que je ne veux pas modifier).


Donc je modifierai cette ligne et je verrai ce que ça donne

Avec vos macros, ainsi que ma restriction, voici ce que la macro donne:


Sub A_Semaine_Suivante()
Dim Ws As Worksheet
For Each Ws In Worksheets
If Ws.Name <> "RECAPITULATIF" And Ws.Name <> "SUIVI TRAVAUX" And Ws.Name <> "TCD" And Ws.Name <> "VUE D'ENSEMBLE" Then
With Ws
.[C10:C18].FormulaLocal = "=SIERREUR(RECHERCHEV($B10;'SUIVI TRAVAUX'!$B:$AE;2;FAUX);"""")"
.[C10:C18] = .[C10:C18].Value

.[D10:D18].FormulaLocal = "=SIERREUR(RECHERCHEV($B10;'SUIVI TRAVAUX'!$B:$AE;3;FAUX);"""")"
.[D10:D18] = .[D10:D18].Value

.[F10:F18].FormulaLocal = "=SIERREUR(RECHERCHEV($B10;'SUIVI TRAVAUX'!$B:$AE;29;FAUX);"""")"
.[F10:F18] = .[F10:F18].Value

.Range("J10:J18,L10:L18").ClearContents
End With
End If
Next

End Sub

Elle est fonctionnelle, sauf que là elle supprime des données qui, au départ, ne doivent pas être supprimées.
Donc j'ai réajusté les formules rechercheV et c'est top (vous avez les modifs en rouge).

Merci pour tout
 
Vote positif 0 Vote négatif
B

benbella1991

XLDnaute Nouveau
Phil69970 à dit:
@benbella1991

Tu remplaces la ligne


par :



Évidement
==> Pas touche1 est le nom de ta 1ere feuille que tu veux exclure à adapter
==> Pas touche2 est le nom de ta 2eme feuille que tu veux exclure à adapter
==> Pas touche3 est le nom de ta 3eme feuille que tu veux exclure à adapter
==> Pas touche4 est le nom de ta 4eme feuille que tu veux exclure à adapter
==> RECAPITULATIF est le nom de ta 5eme feuille que tu veux exclure

Merci de ton retour

@Phil69970
Cliquez pour agrandir...
Justement, c'est ce qui a été fait🥰🥰
 
Vote positif 0 Vote négatif

Discussions similaires

K
  • Question
Microsoft 365 vba :Vlookup + incrémentation d'une plage de donnée
Réponses
1
Affichages
131
vgendron
vgendron
S
  • Résolu(e)
Autres ActiveWorkbook.Worksheets("vierge").AutoFilter.Sort.SortFields.Clear
2
Réponses
23
Affichages
2 K
AtTheOne
AtTheOne
N
  • Résolu(e)
Microsoft 365 Macro copier/coller entre deux tableaux structurés
3 4 5
Réponses
66
Affichages
1 K
job75
job75
F
  • Résolu(e)
XL 2021 Réaliser une macro pour copier une ligne avec formule ?
Réponses
4
Affichages
554
fanou06
F
L
  • Question
XL 2019 Optimiser un code VBA dans un grand jeu de données
Réponses
4
Affichages
742
Loïc DUBOIS
L
K
  • Question
XL 2019 Organiser le code VBA
Réponses
9
Affichages
790
Kevin38
K
mouchtre
  • Résolu(e)
Microsoft 365 Macro fonctionnant avec excel 365 sur windows 11 mais ne fonctionnent pas sur un autre windows 11 avec aussi un excel 365
Réponses
11
Affichages
858
mouchtre
mouchtre
A
  • Résolu(e)
XL 2013 Code VBA incompatible avec version Excel
Réponses
2
Affichages
615
Averell1976
A
M
  • Question
XL 2013 Envoyer un mail automatique avec le contenu de la bonne ligne
Réponses
2
Affichages
801
Oneida
Oneida
M
  • Question
XL 2016 Aide code VBA
Réponses
7
Affichages
672
medsoft313
M

Membres actuellement en ligne

15 membres et 124 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
315 093
Messages
2 116 125
Membres
112 666
dernier inscrit
Coco0505