Copié coller VBA

Le 25/09/2019 à 10:07

Bonjour à tous et à toutes,

Voilà, je vous explique mon problème.

Dans un premier temps je suis débutant en VBA (je ne comprends rien à ce langage).

Dans un deuxième temps j'aimerais sur le fichier joint que :

  • Lorsque je rentre "Facturer "dans la colonne W la ligne de la feuille "Gestion" passe dans la feuille "BRT FACTURER" puis se supprime de la feuille "GESTION"
  • Lorsque j'écris "reste réfection" dans la colonne V la ligne de la feuille "Gestion" passe dans la feuille "Refection" mais ne se supprime pas de la feuille "GESTION"
  • Lorsque je rentre "TERMINER" dans la colonne W la ligne remonte avec les autres ligne "TERMINER"
  • Lorsque je rentre "EN COURS" dans la colonne W la ligne remonte avec les autres ligne "EN COURS"

En espérant que mon besoin soit clair...

Dans l'attente de votre retour je vous remercie par avance.

12gestion-des-branchements-copie.xlsx (144.42 Ko)
Le 25/09/2019 à 15:17

Bonjour

A tester !

13gestion-des-branchements-copie.xlsm (58.68 Ko)
Le 25/09/2019 à 16:54

Bonjour,

est-il possible de faire cela sans macro ?

Car quand je colle ta macro dans mon fichier confidentiel qui est le même fichier avec des cellules pleines la macro ne fonctionne pas : je m'explique : la ligne qui se colle sur BRT FACTURER va en colonne C20 au lieu de s'insérer en B10...

De plus le mode reste refection ne fonctionne pas ...

Désolé....

Le 25/09/2019 à 17:25

Sans macro non c'est pas possible, c'est normal si ça ne marche pas si la disposition n'est pas la même d'un fichier a un autre.

Le 25/09/2019 à 17:27

C'est exactement le même ... Peut être que je ne copie colle pas tout le bon code et que je ne le positionne pas au bon endroit... as tu pu regarder pour le reste refection ?

Merci pour tout

Le 25/09/2019 à 17:39

Je vais reprendre ça demain alors

Le 25/09/2019 à 17:44

As tu un e-mail afin que je t'envoie le fichier ?

Le 26/09/2019 à 09:03

Re

je te remet le code qui fonctionne chez moi :

(A placer dans le module de la feuille GESTION)

Dim StopProcess As Boolean

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
StopProcess = False
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Crit As String
Dim Lig As Integer, NewLig As Integer
Dim f1 As Worksheet, f2 As Worksheet, f3 As Worksheet
Dim C As Object

If StopProcess = True Then Exit Sub

Set f1 = Sheets("GESTION")
Set f2 = Sheets("BRT FACTURER")
Set f3 = Sheets("REFECTION")

If Selection.Count = 1 Then
    If Not Intersect(Target, f1.Range("W:W")) Is Nothing Then
        Crit = UCase(Target)
        If Crit = "FACTURER" Then
            StopProcess = True
            Lig = Target.Row
            f1.Range("B" & Lig & ":W" & Lig).Cut
            f2.Range("B10").Insert Shift:=xlDown
            f1.Range("B" & Lig & ":W" & Lig).Delete Shift:=xlUp
        End If

        If Crit = "TERMINER" Then
            StopProcess = True
            Lig = Target.Row
            f1.Range("B" & Lig & ":W" & Lig).Cut
            f1.Range("B10").Insert Shift:=xlDown
        End If

        If Crit = "EN COURS" Then
            StopProcess = True
            Lig = Target.Row
            Set C = f1.Range("W:W").Find("TERMINER", LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlPrevious)
            If Not C Is Nothing Then
                NewLig = C.Row + 1
                Set C = Nothing
                f1.Range("B" & Lig & ":W" & Lig).Cut
                f1.Range("B" & NewLig).Insert Shift:=xlDown
            Else
                f1.Range("B" & Lig & ":W" & Lig).Cut
                f1.Range("B10").Insert Shift:=xlDown
            End If
        End If
    End If
    If Not Intersect(Target, f1.Range("V:V")) Is Nothing Then
        StopProcess = True
        Lig = Target.Row
        If UCase(Target) Like "*REFECTION*" Then
            f1.Range("B" & Lig & ":W" & Lig).Copy
            f3.Range("B10").Insert Shift:=xlDown
        End If
    End If
End If
End Sub

Si ça ne fonctionne toujours pas je te donnerais mon E-Mail

EDIT 09:17 : J'avais fait une petite erreur, j'ai corrigé ça dans ce poste !

Le 26/09/2019 à 09:20

Bonjour,

Le transfert vers la page Brt Facturer s'effectue bien sauf que ça vient toujours écraser sur la ligne B10 au lieu de s'afficher à la suite.

Peux-tu me passer ton e-mail car j'ai une autre demande à te faire si je peux me permettre ... si je n'abuse pas trop surtout

Le 26/09/2019 à 09:30

Oui effectivement, reprend le code du message précédent que j'ai corrigé

Le 26/09/2019 à 09:56

Je remet le code légèrement modifié et commenté si jamais ça intéresse quelqu'un 

Dim StopProcess As Boolean
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Crit As String
Dim Lig As Integer, NewLig As Integer
Dim f1 As Worksheet, f2 As Worksheet, f3 As Worksheet
Dim C As Object

'La variable StopProcess permet d'empécher l'excution en boucle du code
If StopProcess = True Then StopProcess = False: Exit Sub

Set f1 = Sheets("GESTION") 'La variable f1 représente la feuille GESTION
Set f2 = Sheets("BRT FACTURER") 'Même principe
Set f3 = Sheets("REFECTION") 'Même principe

If Selection.Count = 1 Then 'Si une seule cellule est sélectionnée alors :
    If Not Intersect(Target, f1.Range("W:W")) Is Nothing Then 'Si la cellule séletionnée se trouve dans la colonne W de f1 alors :
        Crit = UCase(Target) 'La varibale Crit représente le contenue de la cellule sélectionnée en majuscule
        If Crit = "FACTURER" Then 'Si la varibale Crit = FACTEUR alors :
            StopProcess = True 'La variable StopProcess passe à l'état VRAI
            Lig = Target.Row 'La varibale Lig prend pour valeur le numéro de la ligne sélectionnée
            f1.Range("B" & Lig & ":W" & Lig).Cut 'La plage contenue entre les colonnes B et W sur la ligne représenté par Lig est coupée
            f2.Range("B10").Insert Shift:=xlDown 'La plage précedement coupée est insérée à partir de la ligne B10 en décalant les autres lignes vers le bas
            f1.Range("B" & Lig & ":W" & Lig).Delete Shift:=xlUp 'La plage précedement définie sur f1 est effacée avec un décalage des autres cellules vers le haut
        End If 'Fin du si Crit = FACTURER

        If Crit = "TERMINER" Then
            StopProcess = True
            Lig = Target.Row
            f1.Range("B" & Lig & ":W" & Lig).Cut
            f1.Range("B10").Insert Shift:=xlDown
        End If

        If Crit = "EN COURS" Then
            StopProcess = True
            Lig = Target.Row
            Set C = f1.Range("W:W").Find("TERMINER", LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlPrevious)
            'C représente la première la première cellule de la colonne W en partant du bas contenant TERMINER
            If Not C Is Nothing Then 'Si la variable C n'est pas nul (si on à trouvé une cellule contenant TERMINER alors :
                NewLig = C.Row + 1 'La varibale NewLig prend pour valeur le numéro de la ligne suivant la ligne représentée par C
                Set C = Nothing
                f1.Range("B" & Lig & ":W" & Lig).Cut 'La plage est coupée
                f1.Range("B" & NewLig).Insert Shift:=xlDown 'La plage coupée est insérée sous la dernière ligne contenant TERMINER
            Else 'Si on à pas trouvé de cellule contenant TERMINER
                f1.Range("B" & Lig & ":W" & Lig).Cut 'La plage est coupée
                f1.Range("B10").Insert Shift:=xlDown 'La plage coupée est insérée en B10
            End If 'Fin du si la varibale C
        End If
    End If
    If Not Intersect(Target, f1.Range("V:V")) Is Nothing Then
        StopProcess = True
        Lig = Target.Row
        If UCase(Target) Like "*REFECTION*" Then 'Si la cellule sélectionnée contient le terme REFECTION alors
            f1.Range("B" & Lig & ":W" & Lig).Copy 'La plage est copiée
            f3.Range("B10").Insert Shift:=xlDown 'La plage copiée est insérée à partir de la cellule B10 sur f3 en décalant les autres cellules vers le bas
        End If
    End If
End If
End Sub
Le 26/09/2019 à 14:47

Je met le code final ici pour les intéressés !

Dim StopProcess As Boolean
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Crit As String, NoDossier As String
Dim Lig As Integer, NewLig As Integer
Dim f1 As Worksheet, f2 As Worksheet, f3 As Worksheet, f4 As Worksheet
Dim C As Object
Dim Max As Long

'La variable StopProcess permet d'empécher l'excution en boucle du code
If StopProcess = True Then StopProcess = False: Exit Sub

Set f1 = Sheets("GESTION") 'La variable f1 représente la feuille GESTION
Set f2 = Sheets("BRT FACTURER") 'Même principe
Set f3 = Sheets("REFECTION") 'Même principe
Set f4 = Sheets("LIAISON B") 'Même principe

If Selection.Count = 1 Then 'Si une seule cellule est sélectionnée alors :
    If Not Intersect(Target, f1.Range("Y:Y")) Is Nothing Then 'Si la cellule séletionnée se trouve dans la colonne Y de f1 alors :
        Crit = UCase(Target) 'La varibale Crit représente le contenue de la cellule sélectionnée en majuscule
        If Crit = "FACTURER" Then 'Si la varibale Crit = FACTEUR alors :
            StopProcess = True 'La variable StopProcess passe à l'état VRAI
            Max = f2.Range("B" & Rows.Count).End(xlUp).Row + 1
            Lig = Target.Row 'La varibale Lig prend pour valeur le numéro de la ligne sélectionnée
            f1.Range("B" & Lig & ":Y" & Lig).Cut f2.Range("B" & Max) 'La plage contenue entre les colonnes B et Y sur la ligne représenté par Lig est coupée
            f2.Range("A" & Max) = Date 'La date du jour est insérée dans la cellule A10 de f2
            StopProcess = True
            f1.Range("B" & Lig & ":Y" & Lig).Delete Shift:=xlUp 'La plage précedement définie sur f1 est effacée avec un décalage des autres cellules vers le haut
            Exit Sub
        End If 'Fin du si Crit = FACTURER

        If Crit = "TERMINER" Then
            StopProcess = True
            Lig = Target.Row
            f1.Range("B" & Lig & ":Y" & Lig).Cut
            f1.Range("B10").Insert Shift:=xlDown
        End If

        If Crit = "EN COURS" Then
            StopProcess = True
            Lig = Target.Row
            Set C = f1.Range("Y:Y").Find("TERMINER", LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlPrevious)
            'C représente la première la première cellule de la colonne Y en partant du bas contenant TERMINER
            If Not C Is Nothing Then 'Si la variable C n'est pas nul (si on à trouvé une cellule contenant TERMINER alors :
                NewLig = C.Row + 1 'La varibale NewLig prend pour valeur le numéro de la ligne suivant la ligne représentée par C
                Set C = Nothing
                f1.Range("B" & Lig & ":Y" & Lig).Cut 'La plage est coupée
                f1.Range("B" & NewLig).Insert Shift:=xlDown 'La plage coupée est insérée sous la dernière ligne contenant TERMINER
            Else 'Si on à pas trouvé de cellule contenant TERMINER
                f1.Range("B" & Lig & ":Y" & Lig).Cut 'La plage est coupée
                f1.Range("B10").Insert Shift:=xlDown 'La plage coupée est insérée en B10
            End If 'Fin du si la varibale C
        End If
    End If

    If Not Intersect(Target, f1.Range("V:V")) Is Nothing Then
        Lig = Target.Row
        Max = f3.Range("B" & Rows.Count).End(xlUp).Row + 1
        If UCase(Target) = "A FAIRE" Then 'Si la cellule sélectionnée = A FAIRE
            f1.Range("B" & Lig & ":Y" & Lig).Copy f3.Range("B" & Max) 'La plage est copiée
        End If
        If Target = "" Then 'Si la cellule sélectionnée est vide
            Lig = Target.Row
            NoDossier = f1.Range("C" & Lig) 'La varibale NoDossier représente le contenue de la cellule de contenant le N° de dossier
            Set C = f3.Range("C:C").Find(NoDossier, LookIn:=xlValues, LookAt:=xlWhole) 'Recherche de la cellule contenant ce même N° de dossier du f3
            If Not C Is Nothing Then 'Si le dossier à été trouvé alors :
                NewLig = C.Row 'NewLig prend pour valeur le numéro de la ligne où se trouve le dossier
                f3.Range("B" & NewLig & ":Y" & NewLig).Delete Shift:=xlUp 'La plage correspondate au N° du dossier est supprimée
                Set C = Nothing
            End If 'Fin de la suppression du dossier
        End If
    End If

    If Not Intersect(Target, f1.Range("W:W")) Is Nothing Then
        Lig = Target.Row
        Max = f4.Range("B" & Rows.Count).End(xlUp).Row + 1
        If UCase(Target) = "A FAIRE" Then 'Si la cellule sélectionnée = A FAIRE
            f1.Range("B" & Lig & ":Y" & Lig).Copy f4.Range("B" & Max) 'La plage est copiée
        End If
        If Target = "" Then
            Lig = Target.Row
            NoDossier = f1.Range("C" & Lig)
            Set C = f4.Range("C:C").Find(NoDossier, LookIn:=xlValues, LookAt:=xlWhole)
            If Not C Is Nothing Then
                NewLig = C.Row
                f4.Range("B" & NewLig & ":Y" & NewLig).Delete Shift:=xlUp
                Set C = Nothing
            End If
        End If
    End If
End If
End Sub
Rechercher des sujets similaires à "copie coller vba"