Copier des lignes dans un tableau de synthèse

Le 06/06/2019 à 09:53

#3

Bonjour à toutes et tous ,

Je souhaite recopier automatiquement dans l'onglet "Plan d'action" les lignes des UT 1 / 2.1 / 2.2 / 3 / 4, la recopie des lignes doit se faire uniquement si les lignes contiennent du texte dans une des colonnes J, K , L ( peu importe la ou les colonnes complétées, si au moins une des cellules des colonnes J K L est complété la recopie doit se faire)

Merci à tous pour votre aide

10doc-de-travail.xlsm (60.23 Ko)
Le 06/06/2019 à 11:15

Bonjoour et

La procédure est à associer au bouton "Transférer des données" ?

Que fait-on des données qui seraient déjà présentes en feuille "Plan d'action" ?

On ne recopie que les 17 premières colonnes de tes feuilles "UT xx" ?

Le 06/06/2019 à 11:27

Bonjour U. Milité et merci pour ta réponse ,

La procédure est à associer au bouton "Transférer des données" ? : Oui je souhaite qu'en cliquant sur le bouton transférer les données on puisse activer le processus de recopie des données issues des UT

Que fait-on des données qui seraient déjà présentes en feuille "Plan d'action" ? le fait de cliquer sur transférer les données nettoie le tableau de plan d'action

On ne recopie que les 17 premières colonnes de tes feuilles "UT xx" ? non , pas de restriction sur le nombre de ligne, par contre, il sera possible de créer d'autres UT , comme par exemple UT 1, UT 2.2 ... Cf fichier joint plus complet en terme de données

merci pour ton aide

2doc-de-travail-avec-ut-en-plus.xlsm (49.38 Ko)
Le 06/06/2019 à 11:41

Re-bonjour,

benoidig a écrit :

On ne recopie que les 17 premières colonnes de tes feuilles "UT xx" ? non , pas de restriction sur le nombre de ligne

Je parle colonnes et tu me réponds lignes je voulais dire qu'il y a une colonne "Commentaire" dans chaque feuille ... qui n'est pas reprise dans "Plan d'action". On ne recopie donc que les 17 colonnes précédent celle des commentaires ?

Il me semble que le premier fichier contenait déjà les 5 feuilles "UT xx"

Le 06/06/2019 à 11:51

Re bonjour,

Je parle colonnes et tu me réponds lignes je voulais dire qu'il y a une colonne "Commentaire" dans chaque feuille ... qui n'est pas reprise dans "Plan d'action". On ne recopie donc que les 17 colonnes précédent celle des commentaires ?

Oops, désolé , oui on conserve les 17 colonnes pas besoin d’intégrer la colonne commentaire dans l'onglet "plan d'action"

Il me semble que le premier fichier contenait déjà les 5 feuilles "UT xx" je me suis emmêlé les pinceaux c'est bien le bon fichier désolé

merci

Le 06/06/2019 à 12:12

Re,

Essaie le fichier joint

J'ai supprimé le code qui figurait dans l'objet ThisWorkbook et ai ajouté un module standard.

Teste soigneusement pour t'assurer que je n'ai rien oublié ... et toi non plus

8transfert-ut-benoidig.xlsm (54.29 Ko)
Le 06/06/2019 à 12:20

Re,

merci pour ton retour, mais je n'ai pas la possibilité de tester j'ai une erreur 1004 lorsque je clique sur le bouton d'exécution

Il semble que l'erreur se situe au niveau du nettoyage de la page

Merci

Le 06/06/2019 à 12:44
benoidig a écrit :

j'ai une erreur 1004 lorsque je clique sur le bouton d'exécution

Désolé, un oubli de ma part: s'il n'y a pas de données en feuille "Plan d'action" (et que la ligne 4 est la dernière non-vide, il ne faut pas l'effacer !)

Remplace le code par celui-ci (un test ajouté en ligne 5 du code):

Sub Transfert2()
Set plan = Sheets("Plan d'action")
derlig = plan.Cells(Rows.Count, 1).End(xlUp).Row
Application.ScreenUpdating = False
If derlig > 4 Then plan.Range(plan.Cells(5, 1), plan.Cells(derlig, 21)).Clear
For Each f In Sheets
    If Left(f.Name, 2) = "UT" Then
        dLig = f.Cells(Rows.Count, 1).End(xlUp).Row
        For lig = 5 To dLig
            If Application.CountA(f.Range(f.Cells(lig, 10), f.Cells(lig, 12))) > 0 Then _
                f.Range(f.Cells(lig, 1), f.Cells(lig, 17)).Copy plan.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(1, 17)
        Next lig
    End If
Next f
Application.ScreenUpdating = True
End Sub
Le 06/06/2019 à 15:02

Merci c'est parfait pour le nettoyage,

Pour le reste c'est vraiment bien merci ,

Je souhaiterai ajouter un critère supplémentaire pour la recopie, je voudrais que si la valeur de colonne N (RISQUE RESIDUEL) est > 40 alors la recopie s'effectue également ,

merci

Le 06/06/2019 à 16:05
benoidig a écrit :

si la valeur de colonne N (RISQUE RESIDUEL) est > 40 alors la recopie s'effectue également

On est d'accord que dans ton exemple, les valeurs en colonne N ne dépassent jamais ce seuil ?

Si oui, ceci devrait fonctionner:

Sub Transfert2()
Set plan = Sheets("Plan d'action")
derlig = plan.Cells(Rows.Count, 1).End(xlUp).Row
Application.ScreenUpdating = False
If derlig > 4 Then plan.Range(plan.Cells(5, 1), plan.Cells(derlig, 21)).Clear
For Each f In Sheets
    If Left(f.Name, 2) = "UT" Then
        dLig = f.Cells(Rows.Count, 1).End(xlUp).Row
        For lig = 5 To dLig
            If Application.CountA(f.Range(f.Cells(lig, 10), f.Cells(lig, 12))) > 0 Or f.Cells(lig, 14) > 40 Then _
                f.Range(f.Cells(lig, 1), f.Cells(lig, 17)).Copy plan.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(1, 17)
        Next lig
    End If
Next f
Application.ScreenUpdating = True
End Sub
Le 06/06/2019 à 16:13
U. Milité a écrit :
benoidig a écrit :

si la valeur de colonne N (RISQUE RESIDUEL) est > 40 alors la recopie s'effectue également

On est d'accord que dans ton exemple, les valeurs en colonne N ne dépassent jamais ce seuil ? [b]En fait il peut arriver que la valeur soit supérieure à 40

2 cas possibles (Soit valeur = 40 soit valeur = 80 : je souhaiterai que pour les valeurs de la colonne N >= à 40 la copie s'effectue

merci [/b]

Si oui, ceci devrait fonctionner:

Sub Transfert2()

Set plan = Sheets("Plan d'action")
derlig = plan.Cells(Rows.Count, 1).End(xlUp).Row
Application.ScreenUpdating = False
If derlig > 4 Then plan.Range(plan.Cells(5, 1), plan.Cells(derlig, 21)).Clear
For Each f In Sheets
    If Left(f.Name, 2) = "UT" Then
        dLig = f.Cells(Rows.Count, 1).End(xlUp).Row
        For lig = 5 To dLig
            If Application.CountA(f.Range(f.Cells(lig, 10), f.Cells(lig, 12))) > 0 Or f.Cells(lig, 14) > 40 Then _
                f.Range(f.Cells(lig, 1), f.Cells(lig, 17)).Copy plan.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(1, 17)
        Next lig
    End If
Next f
Application.ScreenUpdating = True
End Sub
Le 06/06/2019 à 16:17
benoidig a écrit :

je souhaiterai que pour les valeurs de la colonne N >= à 40 la copie s'effectue

Ce n'est donc pas pareil ... je suppose que tu vois quel changement est à apporter au dernier code proposé ?
Le 06/06/2019 à 16:27
U. Milité a écrit :
benoidig a écrit :

si la valeur de colonne N (RISQUE RESIDUEL) est > 40 alors la recopie s'effectue également

On est d'accord que dans ton exemple, les valeurs en colonne N ne dépassent jamais ce seuil ?

Si oui, ceci devrait fonctionner:

Sub Transfert2()
Set plan = Sheets("Plan d'action")
derlig = plan.Cells(Rows.Count, 1).End(xlUp).Row
Application.ScreenUpdating = False
If derlig > 4 Then plan.Range(plan.Cells(5, 1), plan.Cells(derlig, 21)).Clear
For Each f In Sheets
    If Left(f.Name, 2) = "UT" Then
        dLig = f.Cells(Rows.Count, 1).End(xlUp).Row
        For lig = 5 To dLig
            If Application.CountA(f.Range(f.Cells(lig, 10), f.Cells(lig, 12))) > 0 Or f.Cells(lig, 14) > 40 Then _
                f.Range(f.Cells(lig, 1), f.Cells(lig, 17)).Copy plan.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(1, 17)
        Next lig
    End If
Next f
Application.ScreenUpdating = True
End Sub

je pense que oui

merci !

Sub Transfert2()

Set plan = Sheets("Plan d'action")

derlig = plan.Cells(Rows.Count, 1).End(xlUp).Row

Application.ScreenUpdating = False

If derlig > 4 Then plan.Range(plan.Cells(5, 1), plan.Cells(derlig, 21)).Clear

For Each f In Sheets

If Left(f.Name, 2) = "UT" Then

dLig = f.Cells(Rows.Count, 1).End(xlUp).Row

For lig = 5 To dLig

If Application.CountA(f.Range(f.Cells(lig, 15), f.Cells(lig, 17))) > 0 Or f.Cells(lig, 14) >= 40 Then _

f.Range(f.Cells(lig, 1), f.Cells(lig, 21)).Copy plan.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(1, 21)

Next lig

End If

Next f

Application.ScreenUpdating = True

End Sub

Rechercher des sujets similaires à "copier lignes tableau synthese"