(Résolu) Copier un ligne dans un autre feuille

Lise Dupont

XLDnaute Nouveau
Bonjour cher forum,

J'ai un besoin:

Celons la valeur de la cellule S d'une ligne dans ma feuille principal, j'aimerais copier la ligne dans la feuille de son nom à partir de F

En S, deux valeur son disponible: PRISE A CHARGE ou NON

Si Prise à charge est sélectionné, j'aimerais que la ligne soit copié dans la feuille prise a charge à partir de la cell F.

Naturellement, dans la prochaine cell F disponible et de manière automatique et non pas par un bouton.

Question: Si la valeur de F change et qu'elle passe de prise à charge à non dans ma feuille principal, Est-ce possible d'annuler le copier/coller

J'ai tenté d'arriver à quelque chose avec ceci mais j'arrive à bout de nerfs.

Dim PRISE A CHARGE As String, Cell As Range
For Each Cell In Sheets("LISTES ACHAT").Range("S3:" & Range("S3").End(xlDown).Address)
Sheets("LISTES ACHAT").Range("A" & Cell.Row & ":" & "S" & Cell.Row).Copy
Cible = Cell.Value
Sheets(PRISE A CHARGE).Select
Range("A" & ActiveCell.SpecialCells(xlLastCell).Row).End(xlUp).Offset(1, 0).Select
Sheets(Cible).Paste
Application.CutCopyMode = False
Next Cell
End Sub

Merci de bien vouloir m'aider.

Lise
 

Pièces jointes

  • l222ast.xlsm
    87.3 KB · Affichages: 39
  • l222ast.xlsm
    87.3 KB · Affichages: 36
  • l222ast.xlsm
    87.3 KB · Affichages: 36
Dernière édition:

mapomme

XLDnaute Barbatruc
Supporter XLD
Re : Copier un ligne dans un autre feuille

Bonsoir Lise Dupont,

Voir un essai dans le fichier joint.

J'ai un peu modifié votre fichier. Ne sachant pas quelle est la clef du tableau de la feuille LISTES ACHAT, j'ai préféré insérer une colonne avec une clef indépendante des données. Cette clef servira à repérer un même élément au sein des deux tableaux LISTES ACHAT et PRISE A CHARGE.

Cette clef se trouve en colonne A du tableau LISTES ACHAT et en colonne F du tableau PRISE A CHARGE.

Dans le tableau LISTES ACHAT, un double-clique sur la première cellule vide de la colonne A affecte à cette cellule la valeur de clef suivante.

Si la colonne de nom BC est une clef du tableau (pas de doublon de BC dans la colonne) alors on peut réécrire la macro de façon à prendre en compte cette clef (si c'est le cas, le signaler pour adaptation du code)

Le code commenté se trouve entièrement dans le module de code de la feuille LISTES ACHAT :
VB:
Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
' attribuer la clef suivante
Dim max As Long

  'si la première cellule vide de la colonne A est celle sur laquelle on a double cliqué
  If Target.Address = Range("a" & Rows.Count).End(xlUp).Offset(1).Address Then
    Cancel = True
    'on recherche le max des clefs au dessus de la cellule vide et on rajoute 1
    max = Application.WorksheetFunction.max(Range("a3:a" & Target.Row - 1)) + 1
    'on copie la cellule au dessus de target sur target
    'permet aussi de recopier le format
    Target.Offset(-1).Copy Target
    'remplacer la valeur de target par max
    Target = max
  End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rgColonneT As Range, xcell As Range, rgTrouve As Range

' en cas d'erreur, on réactive l'interception des évènements et on quitte
On Error GoTo Erreur_001

' on bloque l'interception des évènements
Application.EnableEvents = False
' on bloque l'affichage
Application.ScreenUpdating = False
' on recherche les valeurs de la colonne T qui ont changé
Set rgColonneT = Intersect(Target, Columns("t:t"))
'Pour chaque cellule qui a changé
For Each xcell In rgColonneT.Cells
  If xcell = "NON" Then
    'on recherche la clef de la la ligne correspondant à xcell
    ' dans la colonne F de la feuille "PRISE A CHARGE"
    With Worksheets("PRISE A CHARGE")
      Set rgTrouve = Nothing
      Set rgTrouve = .Columns("f:f").Find(what:=Range("a" & xcell.Row), _
                    LookIn:=xlValues, lookat:=xlWhole)
      If Not rgTrouve Is Nothing Then
        ' on a trouvé la clef => on efface la ligne correspondante
        .Rows(rgTrouve.Row).Delete
      End If
    End With
  ElseIf xcell = "Prise à charge" Then
    'on recherche la clef de la la ligne correspondant à xcell
    ' dans la colonne F de la feuille "PRISE A CHARGE"
    With Worksheets("PRISE A CHARGE")
      Set rgTrouve = Nothing
      Set rgTrouve = .Columns("f:f").Find(what:=Range("a" & xcell.Row), _
                    LookIn:=xlValues, lookat:=xlWhole)
      If Not rgTrouve Is Nothing Then
        ' on a trouvé la clef => on efface la ligne correspondante
        .Rows(rgTrouve.Row).Delete
      End If
      ' on recherche la première ligne vide dans la feuille "PRISE A CHARGE"
      Set rgTrouve = .Range("f" & .Rows.Count).End(xlUp).Offset(1)
      ' on copie la ligne de la feuille "LISTE ACHAT" vers la feuille "PRISE A CHARGE"
      Range("a" & xcell.Row & ":t" & xcell.Row).Copy rgTrouve
      ' formatage
      With rgTrouve.Resize(, Range("a1:t1").Columns.Count)
        .Value = .Value
        .FormatConditions.Delete
        .Validation.Delete
        .Interior.ColorIndex = xlColorIndexNone
        .Borders.LineStyle = msoLineSingle
      End With
      .Range("a" & rgTrouve.Row & ":e" & rgTrouve.Row).Borders.LineStyle = msoLineSingle
    End With
  End If
Next xcell

Erreur_001:
  ' on réactive l'interception des évènements
  Application.EnableEvents = True
  ' on bloque l'affichage
  Application.ScreenUpdating = False
End Sub
 

Pièces jointes

  • Lise Dupont-l222ast-v1.xlsm
    44.7 KB · Affichages: 24

Lise Dupont

XLDnaute Nouveau
Re : Copier un ligne dans un autre feuille

Bonsoir mapomme, le fil et cher forum,

Dans mon fichier la clé pourrait être la colonne A. les donnés séquentiel qui y sont ( A34M-50002) etc sont unique.

Je ne sais pourquoi mais tout mes MFC ne fonctionne plus dans ton fichier, mes boutons tri etc.....

J'apprécie énormément tes effort mais le résultat est tellement loin de ma version original et implique que mes employés devront changer leur méthodes d'entré de donné et je dois recommencer mes automatisme... :(

Je me suis surement mal exprimé.

Si la cell »S« d'une ligne égal Prise à charge, copier cette ligne dans la feuille Prise à charge.
le coller doit être fait sur la plage A3:S3 et aller sur la plage F3:X3.... Ceci permettra d'entrer des donné en avant (col a,b,c,d,e )

Désolé mais Merci du fond du cœur....

Je commence à croire que mes idées sont trop poussés et que je devrez faire faire les copier manuellement et vérifier en arrière eux
 

mapomme

XLDnaute Barbatruc
Supporter XLD
Re : Copier un ligne dans un autre feuille

Re,

Voir la version v2 avec la présentation initiale.

Le code est identique au précédent ; on a juste remplacé, au sein du code, les rares expressions contenant une référence à la colonne T par une référence à la colonne S.
 

Pièces jointes

  • Myst-cacher & afficher bouton-v2.xlsm
    92.2 KB · Affichages: 29
Dernière édition:

Discussions similaires

Statistiques des forums

Discussions
311 709
Messages
2 081 769
Membres
101 816
dernier inscrit
Jfrcs