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

Titou99

XLDnaute Junior
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
 

Pièces jointes

  • doc forum.xlsm
    314.4 KB · Affichages: 7

Titou99

XLDnaute Junior
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

XLDnaute Impliqué
Supporter XLD
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
 

Pièces jointes

  • doc forum (1).xlsm
    233 KB · Affichages: 14

job75

XLDnaute Barbatruc
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 :
VB:
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 :
VB:
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+
 

Pièces jointes

  • doc forum(1).xlsm
    341.3 KB · Affichages: 23
Dernière édition:

Discussions similaires

Statistiques des forums

Discussions
311 725
Messages
2 081 943
Membres
101 849
dernier inscrit
florentMIG