Pb code VBA - Transfert de données vers une autre feuille

[Titou99]

Bonjour à tous,

Je vous explique mon souci :

- Dans la feuille "ANALYSE IPR", je voudrais transférer toutes les lignes qui contiennent le mot "OUI" dans la colonne "Prise en charge" vers la feuille suivante "ACTIONS CORRECTIVES" (avec le bouton "Transfert des données" en haut à droite)

- Ensuite, dans la feuille "ACTIONS CORRECTIVES", je voudrais transférer toutes les lignes qui contiennent le chiffre 4 dans la colonne "Statut" vers la feuille "SAISIE DES DONNÉES" qui viendra écraser les lignes identiques avec pour référence le numéro de la ligne de la colonne #. (avec le bouton "Transfert des nouvelles cotations en haut à droite)

Je vous joint le fichier

cdt

 

[laurent3372]

Quand tu parles de Transférer, faut-il supprimer les lignes transférées de la feuille d'origine après qu'elles aient été transférées ?

 

[Titou99]

Pour le premier transfert non mais le deuxième oui

 

[laurent3372]

Lors du 2° transfert (ACTIONS CORRECTIVES vers SAISIE DES DONNES), quelles informations de la ligne dans SAISIE DES DONNEES doit-on mettre à jour ?

 

[Titou99]

La ligne correspondante, c'est à dire la ligne qui possède le même numéro de la première colonne "#"

Les info a transférer de la feuille "ACTIONS CORRECTIVES" vers "SAISIE DES DONNEES" sont :

-#
-N°Actions Process
-Process
-Mode de Défaillance
-Effet Potentiel de la Défaillance
-Sev
-Occ
-Det

 

[laurent3372]

Voici ma solution.

• J'ai transformé les tableaux en tableaux structurés, ce qui simplifie la gestion du nombre de lignes des divers tableaux.
• J'ai supprimé les boutons "Ajuster la largeur des colonnes" qui rendent la feuille illisible et dont l'action n'est pas réversible. Je l'ai remplacé par un retour à la ligne automatique des celllules dont la hauteur s'adapte automatiquement
• Dans la feuille "SAISIE DES DONNEES", j'ai créé une procédure "Générer Analyse IPR" qui génère le contenu de la feuille ANALYSE IPR.
• Dans la feuille SAISIE DES DONNEES, l'en-tête est tout perturbé par la nouvelle largeur des colonnes. Il faudrait le ré-écrire en s'inspirant de la feuille AMDEC (sans contrôles, seulement des cellules de la feuille)
• Comme demandé, j'ai créé les procédures de transfert ANALYSE IPR -> ACTIONS CORRECTIVES et ACTIONS CORRECTIVES ->SAISIE DES DONNEES

Cordialement,
--
LR

 

[job75]

Bonjour Titou99, laurent3372, le forum,

Pour le 1er transfert vous ne dites pas ce qu'on fait des données existantes dans la feuille de destination.

Cette macro les supprime purement et simplement :

Private Sub CommandButtonTransfert1_Click() 'Transfert des données
Dim F As Worksheet
Set F = Sheets("ACTIONS CORRECTIVES")
Application.ScreenUpdating = False
F.Rows("14:" & F.Rows.Count).Delete 'RAZ
F.Columns("H").Insert
With [A13].CurrentRegion
    .AutoFilter 8, "OUI" 'filtre automatique
    .Copy F.[A13]
    .AutoFilter
End With
F.Columns("H").Delete
With F.[A13].CurrentRegion
    .Value = .Value 'supprime les formules au cas (peu probable) où il y en a
    .Borders.Weight = xlThin 'bordures
    With .Columns(16).Validation
        .Delete
        .Add xlValidateList, Formula1:="0,1,2,3,4" 'liste de validation pour Statut
    End With
    .Cells(1, 16).Validation.Delete 'supprimée sur P13
End With
F.Activate 'facultatif
End Sub

Edit : validation supprimée sur P13.

Pour le 2ème transfert les formules existantes dans les colonnes A et B de la feuille de destination seront supprimées, apparemment c'est ce que vous voulez :

Private Sub CommandButtonTransfert2_Click() 'Transfert des nouvelles cotations
Dim F As Worksheet, i&, lig As Variant
Set F = Sheets("SAISIE DES DONNEES")
Application.ScreenUpdating = False
With [A13].CurrentRegion
    For i = .Rows.Count To 2 Step -1
        If .Cells(i, 16) = 4 Then 'Statut
            lig = Application.Match(.Cells(i, 1), F.Columns(1), 0)
            If IsNumeric(lig) Then
                F.Cells(lig, 1).Resize(, 4) = .Cells(i, 1).Resize(, 4).Value
                F.Cells(lig, 6).Resize(, 2) = .Cells(i, 5).Resize(, 2).Value
                F.Cells(lig, 8).Resize(, 2) = .Cells(i, 12).Resize(, 2).Value 'Sev, Occ
                F.Cells(lig, 12) = .Cells(i, 14) 'Det
                .Rows(i).Delete xlUp 'supprime la ligne
            End If
        End If
    Next
End With
End Sub

A+

 

[Titou99]

Bonjour à vous deux,

Juste merci pour votre aide vous êtes géniaux !

Je test le fichier et vous tiens au courant !