Vous utilisez un navigateur obsolète. Il se peut que ce site ou d'autres sites Web ne s'affichent pas correctement. Vous devez le mettre à jour ou utiliser un navigateur alternatif.
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 !
Tu peux remplacer ta macro (Macro1) par celle-ci :
Code:
Sub ResteAFaire()
Feuil2.Range("9:100").EntireRow.Delete
lg1 = 9
With Feuil1
For lg = 8 To .Range("F65536").End(xlUp).Row
Set levee = .Range("AK" & lg & ":AM" & lg).Find("OK", LookIn:=xlValues, lookat:=xlWhole)
If levee Is Nothing Then
.Range("A" & lg).EntireRow.Copy
ActiveSheet.Paste Destination:=Rows(lg1)
lg1 = lg1 + 1
End If
Next
End With
With Feuil3
For lg = 8 To .Range("F65536").End(xlUp).Row
Set levee = .Range("AK" & lg & ":AM" & lg).Find("OK", LookIn:=xlValues, lookat:=xlWhole)
If levee Is Nothing Then
.Range("A" & lg).EntireRow.Copy
ActiveSheet.Paste Destination:=Rows(lg1)
lg1 = lg1 + 1
End If
Next
End With
End Sub
Tu peux remplacer ta macro (Macro1) par celle-ci :
Code:
Sub ResteAFaire()
Feuil2.Range("9:100").EntireRow.Delete
lg1 = 9
With Feuil1
For lg = 8 To .Range("F65536").End(xlUp).Row
Set levee = .Range("AK" & lg & ":AM" & lg).Find("OK", LookIn:=xlValues, lookat:=xlWhole)
If levee Is Nothing Then
.Range("A" & lg).EntireRow.Copy
ActiveSheet.Paste Destination:=Rows(lg1)
lg1 = lg1 + 1
End If
Next
End With
With Feuil3
For lg = 8 To .Range("F65536").End(xlUp).Row
Set levee = .Range("AK" & lg & ":AM" & lg).Find("OK", LookIn:=xlValues, lookat:=xlWhole)
If levee Is Nothing Then
.Range("A" & lg).EntireRow.Copy
ActiveSheet.Paste Destination:=Rows(lg1)
lg1 = lg1 + 1
End If
Next
End With
End Sub
Heureux d'avoir pu t'aider, et plus encore à continuer de le faire.
Voici donc ton code modifié et commenté :
Code:
Sub ResteAFaire()
Application.ScreenUpdating = False ' Supprime le rafraîchissement de l'écran durant le déroulement de la macro (évite le "scintillement" et accélère le déroulement de la macro)
[COLOR="RoyalBlue"]Feuil2.Range("9:" & Feuil2.UsedRange.Rows.Count + 1).EntireRow.Delete[/COLOR] ' Supprime les lignes 9 à 100 dans la ligne "reste à faire"
lg1 = 9 ' Initialisation de la ligne de départ dans la feuille "reste à faire"
With Feuil1 ' Lecture des données sur la feuille "comp sup"
For lg = 8 To .Range("F65536").End(xlUp).Row ' Balayage de la ligne 8 à la dernière ligne remplie (dans la colonne F)
Set levee = .Range("AK" & lg & ":AM" & lg).Find("OK", LookIn:=xlValues, lookat:=xlWhole) ' Recherche de la valeur OK dans les colonnes AK..AM de la ligne en cours d'analyse
If levee Is Nothing Then ' Si la valeur OK n'est pas trouvée
.Range("A" & lg).EntireRow.Copy ' On copie la ligne en cours
ActiveSheet.Paste Destination:=Rows(lg1) ' Et on la colle dans la ligne lg1 de la feuille 'reste à faire'
lg1 = lg1 + 1 ' On descend d'une ligne dans la feuille "reste à faire"
End If
Next
End With
With Feuil3 ' Lecture des données sur la feuille "comp inf"
' la suite est identique au paragraphe précédent
For lg = 8 To .Range("F65536").End(xlUp).Row
Set levee = .Range("AK" & lg & ":AM" & lg).Find("OK", LookIn:=xlValues, lookat:=xlWhole)
If levee Is Nothing Then
.Range("A" & lg).EntireRow.Copy
ActiveSheet.Paste Destination:=Rows(lg1)
lg1 = lg1 + 1
End If
Next
Application.CutCopyMode = True ' Supprime la ligne en "surbrillance" (équivaut à la commande "Echap")
End With
Application.ScreenUpdating = True ' Rétablit le rafraîchissement de l'écran
End Sub
Quelques remarques :
J'ai rajouté les instructions "Application.ScreenUpdating" afin d'améliorer la présentation à l'écran et la rapidité d'exécution de la macro. C'est surtout utile si la macro traite un grand nombre de lignes.
J'ai également modifié la ligne en bleu : auparavant, je supprimais les lignes 9 à 100, maintenant je supprime uniquement les lignes remplies, à partir de la neuvième.
Si je supprime ces lignes (au lieu de les effacer), c'est pour réinitialiser les formats de cellule au cas ou le nombres de lignes serait inférieur à la mouture précédente.
Heureux d'avoir pu t'aider, et plus encore à continuer de le faire.
Voici donc ton code modifié et commenté :
Code:
Sub ResteAFaire()
Application.ScreenUpdating = False ' Supprime le rafraîchissement de l'écran durant le déroulement de la macro (évite le "scintillement" et accélère le déroulement de la macro)
[COLOR="RoyalBlue"]Feuil2.Range("9:" & Feuil2.UsedRange.Rows.Count + 1).EntireRow.Delete[/COLOR] ' Supprime les lignes 9 à 100 dans la ligne "reste à faire"
lg1 = 9 ' Initialisation de la ligne de départ dans la feuille "reste à faire"
With Feuil1 ' Lecture des données sur la feuille "comp sup"
For lg = 8 To .Range("F65536").End(xlUp).Row ' Balayage de la ligne 8 à la dernière ligne remplie (dans la colonne F)
Set levee = .Range("AK" & lg & ":AM" & lg).Find("OK", LookIn:=xlValues, lookat:=xlWhole) ' Recherche de la valeur OK dans les colonnes AK..AM de la ligne en cours d'analyse
If levee Is Nothing Then ' Si la valeur OK n'est pas trouvée
.Range("A" & lg).EntireRow.Copy ' On copie la ligne en cours
ActiveSheet.Paste Destination:=Rows(lg1) ' Et on la colle dans la ligne lg1 de la feuille 'reste à faire'
lg1 = lg1 + 1 ' On descend d'une ligne dans la feuille "reste à faire"
End If
Next
End With
With Feuil3 ' Lecture des données sur la feuille "comp inf"
' la suite est identique au paragraphe précédent
For lg = 8 To .Range("F65536").End(xlUp).Row
Set levee = .Range("AK" & lg & ":AM" & lg).Find("OK", LookIn:=xlValues, lookat:=xlWhole)
If levee Is Nothing Then
.Range("A" & lg).EntireRow.Copy
ActiveSheet.Paste Destination:=Rows(lg1)
lg1 = lg1 + 1
End If
Next
Application.CutCopyMode = True ' Supprime la ligne en "surbrillance" (équivaut à la commande "Echap")
End With
Application.ScreenUpdating = True ' Rétablit le rafraîchissement de l'écran
End Sub
Quelques remarques :
J'ai rajouté les instructions "Application.ScreenUpdating" afin d'améliorer la présentation à l'écran et la rapidité d'exécution de la macro. C'est surtout utile si la macro traite un grand nombre de lignes.
J'ai également modifié la ligne en bleu : auparavant, je supprimais les lignes 9 à 100, maintenant je supprime uniquement les lignes remplies, à partir de la neuvième.
Si je supprime ces lignes (au lieu de les effacer), c'est pour réinitialiser les formats de cellule au cas ou le nombres de lignes serait inférieur à la mouture précédente.
Je vous joins mon fichier complété car je n'arrive pas à faire la marco pour toute les feuilles.
Et j'aurais encore un point que je voudrais changer pour la macro.
Lors que sur une feuille toutes les lignes ont "ok" dans la colonne levée. Il faudrait que la macro ne vienne pas réinscrire l'entête avec le compartiment, observation... car il n'y a plus de retouches dans ce compartiment.
Je souhaiterais aussi faire un seconde fichier.
Ce fichier doit en faite faire un regroupement des données du premier
Par exemple je voudrais regroupé toutes les retouches du poste.
Comment peux t on faire cela, sur la base de votre macro.
Est t'il possible de faire cela avec le premier fichier fermé ?
Si jamais je ne me suis pas bien expliquais dite le
Nota : pour répondre à ton besoin, j'ai ajouté une formule en colonne AQ1 (que j'ai masquée) sur chaque feuille sauf la dernière. Cette formule permet de déterminer si les OK sont complets. J'ai aussi effacé tous les OK qui se trouvaient sur des lignes vides.
Je te laisse le loisir de tester le résultat.
Concernant le second fichier, je ne comprends pas bien le sens de la question, si tu pouvais me le préciser ?
Merci pour le 1er fichier il fonctionne très bien et correspond vraiment à ce que je voulais.
Pour le seconde fichier
En faite dans la colonne dans D il y a les postes de montages (ex 25, 24, 23, chau...).
je souhaiterais faire d'autre fichiers qui reprendraients tous les défauts imputés aux différents postes 25, 24....
En faite il faudrait que la macro s'active par un bouton, qu'elle fasse un copier coller des lignes ayant un 25 en colonne D, et aussi qu'elle inscrive et compartiment comme dans le reste à faire.
Merci pour le 1er fichier il fonctionne très bien et correspond vraiment à ce que je voulais.
Pour le seconde fichier
En faite dans la colonne dans D il y a les postes de montages (ex 25, 24, 23, chau...).
je souhaiterais faire d'autre fichiers qui reprendraients tous les défauts imputés aux différents postes 25, 24....
En faite il faudrait que la macro s'active par un bouton, qu'elle fasse un copier coller des lignes ayant un 25 en colonne D, et aussi qu'elle inscrive et compartiment comme dans le reste à faire.
je souhaiterais faire d'autre fichiers qui reprendraients tous les défauts imputés aux différents postes 25, 24....
Veux-tu dire nouveaux fichiers, ou nouvelles feuilles ?
qu'elle fasse un copier coller des lignes ayant un 25 en colonne D
D'autre part, il n'y a aucune ligne renseignée dans ton fichier, peux-tu m'envoyer un exemple avec quelques lignes, et le résultat que tu veux obtenir ?
je souhaiterais faire d'autre fichiers qui reprendraients tous les défauts imputés aux différents postes 25, 24....
Veux-tu dire nouveaux fichiers, ou nouvelles feuilles ?
qu'elle fasse un copier coller des lignes ayant un 25 en colonne D
D'autre part, il n'y a aucune ligne renseignée dans ton fichier, peux-tu m'envoyer un exemple avec quelques lignes, et le résultat que tu veux obtenir ?
Je souhaite faire un autre fichier excel (je le joins avec un exemple dedans de ce que je souhaite, fait par un copier coller manuel).
Il y aura autant de fichiers que de postes de montages (6 ou 7 en tout).
Pour le moment je me concentre que sur un le poste 25.
Il faudrait que le fichier poste 25 prenne directement les informations dans le fichier retouches V 8156.
Peut on faire cela ?
Si c'est impossible on peut faire de façon différente (à la place de créer un autre fichier, c'est créer une nouvelle feuille dans le fichier retouches V 8156)
C'est possible de le faire en créant des fichiers distincts, mais c'est plus compliqué que de le faire sur de nouvelles feuilles dans le fichier existant. De plus, la gestion d'un seul fichier me paraît, dans ce cas, des plus appropriées. Si tu y tiens, je peux regarder la solution des fichiers multiples, mais je ne pourrais pas m'y atteler avant ce soir.
C'est possible de le faire en créant des fichiers distincts, mais c'est plus compliqué que de le faire sur de nouvelles feuilles dans le fichier existant. De plus, la gestion d'un seul fichier me paraît, dans ce cas, des plus appropriées. Si tu y tiens, je peux regarder la solution des fichiers multiples, mais je ne pourrais pas m'y atteler avant ce soir.
Restons sur le plus simple car je voudrais pouvoir me resservir du fichier seul.
donc recréer un nouvel onglet. Tu pourras remettre des explications dans la macro pour que je suis faire les autres onglets (poste 24, 23....)
Restons sur le plus simple car je voudrais pouvoir me resservir du fichier seul.
donc recréer un nouvel onglet. Tu pourras remettre des explications dans la macro pour que je suis faire les autres onglets (poste 24, 23....)
Voici ton fichier remanié.
Les explications que je t'ai fournies dans le code ne sont là que pour que tu puisses étudier le principe, car j'ai créé un nouveau bouton (Extraire Poste) qui te permettra de choisir un poste dans la liste déroulante.
Le programme récupère tout seul les postes figurant dans la feuille "reste à faire" et, pour permettre un tri alphanumérique des postes, j'ai collé des données dans la colonne BA, qui est masquée.
Je suis conscient que ce code est loin d'être optimisé (il a été remanié au fur et à mesure) mais il fonctionne.
Pour le confort de lecture des tableaux, je te conseillerais de ne griser que les lignes de titres et de libellés de colonnes sur les feuilles de données, car sur les feuilles filtrées l'espacement n'est plus régulier.
Espérant que tu y trouves l'aboutissement souhaité.
- 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
