Copier ligne filtée vers une autre ligne filtrée

Question

J'ai un soucis avec une fichier que je construit ou je dois faire une recherche de Noms. J'aimerais filtrer deux onglets qui ont une valeur commune et copier une plage de cellules d'une ligne filtrée d'un premier onglet sur la ligne filtrée d'un deuxième onglet. A l'aide d'une ComboBox, J'aimerai que cette recherche et le copier-coller se fasse automatiquement par variables pour remplacer le Nom et la plage de cellules à copier - coller. Ci-joint ce que me donne l'enregistreur de macro: Sub Macro16() ActiveSheet.Range("$A$13:$CY$997").AutoFilter Field:=18, Criteria1:= _ "MULON BENJAMIN" Sheets("SCHILTZ.K").Select ActiveSheet.Range("$A$13:$BW$57").AutoFilter Field:=18, Criteria1:= _ "MULON BENJAMIN" Sheets("RH POLYVALENCE").Select Range("U29:BO29").Select Selection.Copy Sheets("SCHILTZ.K").Select Range("U17").Select ActiveSheet.Paste Application.CutCopyMode = False ActiveWorkbook.Save End Sub Pourriez vous me créer un exemple s'il vous plait? Merci d'avance à vous ...

Theze · Answer

A tester mais sans fichier ? Sub Macro16() Dim Lig As Long 'les résultats son collés sur la feuille "RH POLYVALENCE" With ActiveSheet.Range("$A$13:$CY$997") '&lt;-- connais pas le nom de la feuille ! .AutoFilter 18, "MULON BENJAMIN" .AutoFilter.Range.EntireRow.Copy Worksheets("RH POLYVALENCE").Cells(1, 1) End With With Worksheets("SCHILTZ.K").Range("$A$13:$BW$57") .AutoFilter 18, "MULON BENJAMIN" Lig = Worksheets("RH POLYVALENCE").Cells(Rows.Count, 1).End(xlUp).Row + 1 'prmier ligne vide en colonne A .AutoFilter.Range.EntireRow.Copy Worksheets("RH POLYVALENCE").Cells(Lig, 1) End With ActiveWorkbook.Save End Sub...

Theze · Answer

Re,

Si tu veux juste reporter la valeur saisie dans la feuille "RH POLYVALENCE", je partirai plutôt sur l'événement Change() de la feuille pour reporter la valeur. La seule contrainte est que le nom des feuilles doit être formé comme tu l'as fais c'est à dire le nom de famille et la première lettre du prénom car le nom de la feuille est construit avec cette ligne :

Nom = Split(Cells(Target.Row, 18).Value, " ")(0) & "." & Left(Split(Cells(Target.Row, 18).Value, " ")(1), 1)

code à mettre dans le module de la feuille "RH POLYVALENCE" :

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim Fe As Worksheet
    Dim Nom As String

    If Target.Column > 66 Then Exit Sub
    If Target.Column < 20 Then Exit Sub
    If Target.Row < 15 Then Exit Sub
    If Target.Count > 1 Then Exit Sub

    Nom = Split(Cells(Target.Row, 18).Value, " ")(0) & "." & Left(Split(Cells(Target.Row, 18).Value, " ")(1), 1)

    On Error Resume Next
    Set Fe = Worksheets(Nom)
    If Err.Number <> 0 Then MsgBox "La feuille '" & Nom & "' n'existe pas dans le classeur, dans le cas contraire, vérifier son orthographe !": Exit Sub

    Fe.Cells(Target.Row, Target.Column).Value = Target.Value

End Sub

Theze · Answer

Re,

To classeur est trop lourd et je ne vais pas le zipper ou le poster ailleurs mais il te suffit de mettre le code dans le module de la feuille "RH POLYVALENCE" là où il y a déjà des procédures événementielles (ces dernières tu as su les mettre !), tu la mets ou tu veux, au début, à la fin ou même entre deux. J'ai commenté le code :

'si j'ai bien compris la demande, la valeur saisie dans la zone qui va de U15 à BOx de cette feuille (RH POLYVALENCE)
'va être entrée dans la même cellule mais dans la feuille cible fonction du nom de la personne qui se trouve sur la
'même ligne en colonne R
Private Sub Worksheet_Change(ByVal Target As Range)

    Dim Fe As Worksheet
    Dim Nom As String

    'défini la zone de la colonne U à la colonne BO et à partir de le ligne 15
    If Target.Column > 66 Then Exit Sub
    If Target.Column < 20 Then Exit Sub
    If Target.Row < 15 Then Exit Sub
    If Target.Count > 1 Then Exit Sub

    'construit le nom de la feuille à partir du nom de famille et de l'initiale du prénom avec un point comme séparation
    Nom = Split(Cells(Target.Row, 18).Value, " ")(0) & "." & Left(Split(Cells(Target.Row, 18).Value, " ")(1), 1)

    'gère l'erreur de la feuille inexistante
    On Error Resume Next
    Set Fe = Worksheets(Nom)
    If Err.Number <> 0 Then MsgBox "La feuille '" & Nom & "' n'existe pas dans le classeur, dans le cas contraire, vérifier son orthographe !": Exit Sub

    'inscrit la valeur dans la même cellule mais dans la feuille portant le nom de famille
    Fe.Cells(Target.Row, Target.Column).Value = Target.Value

End Sub

Theze · Answer

Là, effectivement dans ce cas, je ne pige pas

Donc, admettons que tu doubles clique dans la cellule AA31 (ligne "Mulon Benjamin") de la feuille "RH POLYVALENCE" un formulaire s'ouvre, que doit t'il se passer après ? Ou est indiqué le responsable maîtrise, est-ce "Mulon Benjamin", doit-on inscrire la valeur qui va être entrée dans la cellule où on a double cliqué après avoir cliqué sur un des boutons du formulaire ?

Expliques la procédure de fonctionnement suite au double clic et le résultat escompté !