Déplacer des lignes dans un autre onglet selon valeur d'une cellule

**Accessifiante** · 01/05/2014, 15h59

Bonjour les cracks,

Mon caprice est peut-être impossible ou trop compliqué, mais qui ne demande rien n'a rien...

Dans le tableau ci-joint, je voudrais que les lignes dont la valeur n'est pas nulle dans la colonne G soient déplacées dans l'onglet "Absents". De même, lorsque l'absence est supprimée en G de l'onglet "Absents", la ligne revienne dans le premier onglet.

Je joins un fichier exemple (à noter qu'en réalité j'ai beaucoup plus de colonnes mais mon critère est la colonne des absences).

Un merci beaucoup à ceux qui voudront bien consacrer quelques temps à ma demande.

**parmi** · 01/05/2014, 16h33

Bonjour,

Voici un exemple pour transférer les absences.
Il te suffit d'utiliser le même principe pour faire l'inverse.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub TransfertAbsence()
    Dim nbLignes As Long, Ligne As Long
 
    Sheets("Suivi").AutoFilterMode = False  'enlève les filtres
    nbLignes = Sheets("Suivi").Cells(Rows.Count, "A").End(xlUp).Row  'détermine le nombre de lignes
    Sheets("Suivi").Rows(1).AutoFilter Field:=7, Criteria1:="<>"  'filtre sur les non vides
 
    Ligne = Sheets("Absents").Cells(Rows.Count, "A").End(xlUp).Row + 1  'détermine la première ligne vide
    Sheets("Suivi").Range("A2:G" & nbLignes).SpecialCells(xlCellTypeVisible).Copy
    Sheets("Absents").Range("A" & Ligne).PasteSpecial xlPasteValues
 
    Application.CutCopyMode = False
End Sub

petit oubli...
J'ai utilisé Copy, mais ça aurait dû être Cut pour couper...

**Accessifiante** · 01/05/2014, 17h00

Bonjour Parmi !

Nous avons un très bon début. Merci !

Cependant, si je remplace Copy par Cut, VBA surligne la ligne en jaune. Il n'aime vraisemblablement pas le Cut. On pourrait laisser le Copy et lui demander ensuite d'effacer les lignes en "Suivi" qui ont été filtrées ?

J'ai une autre question : ce code fonctionne soit en insérant un bouton dans mon tableau ou dans la barre d'outils, soit en appelant la macro depuis l'onglet Développeur. Cependant, au départ, mon idée était de lancer la macro au moment où l'utilisateur fait un choix dans la liste déroulante des absences, c'est à dire que la mise à jour se fait au fur et à mesure de la saisie. Est-ce que ça modifie beaucoup le code dans ce cas ?

**parmi** · 01/05/2014, 17h09

On pourrait utiliser Worksheet_Change()
Mais que se passe-t-il si les autres cellules ne sont pas remplies ?

Ça donnerait ceci sans autre validation

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim nbLignes As Long, Ligne As Long
 
    'Vérifier si on a bien changé la valeur en G
    If Target.Column <> 7 Then Exit Sub
 
    If Target.Value <> "" Then
 
       Ligne = Sheets("Absents").Cells(Rows.Count, "A").End(xlUp).Row + 1  'détermine la première ligne vide
 
       'Copie de la ligne en cours
       Sheets("Suivi").Range("A" & Target.Row & ":G" & Target.Row).Copy Sheets("Absents").Range("A" & Ligne)
       Sheets("Suivi").Rows(Target.Row).Delete
 
       Application.CutCopyMode = False
    End If
End Sub

**Accessifiante** · 01/05/2014, 17h20

Mais que se passe-t-il si les autres cellules ne sont pas remplies ?

Très bonne remarque, je n'avais pas pensé à ça... On revient donc à nos moutons du début, et je m'arrangerai avec le moment où ça se déclenche.

Pourquoi est-ce que le Cut ne marche pas ? Comment indiquer en VBA de supprimer les lignes filtrées en "Suivi" une fois qu'elles ont été copiées en "Absents" ? J'ai essayé de faire un enregistrement de macro pour l'adapter dans votre code mais je vois que la référence à la plage est absolue, donc ça va niaiser (je ne sais pas comment lui écrire la référence relative des lignes filtrées) :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
ActiveSheet.Range("$A$1:$G$15").AutoFilter Field:=7, Criteria1:="<>"
    Rows("2:9").Select
    Selection.Delete Shift:=xlUp

**parmi** · 01/05/2014, 17h25

Mon 2e code fonctionne bien et rapidement.
Il faudrait, par contre, valider les champs "obligatoires" avant de copier les données.

Est-ce que les 6 autres colonnes doivent être remplies

En supposant que toutes les cellules doivent être remplies, on pourrait valider ainsi

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim nbLignes As Long, Ligne As Long
 
    'Vérifier si on a bien changé la valeur en G
    If Target.Column <> 7 Then Exit Sub
 
    If Target.Value <> "" Then
        If IsValide(Target.Row) Then
            Ligne = Sheets("Absents").Cells(Rows.Count, "A").End(xlUp).Row + 1  'détermine la première ligne vide
 
            'Copie de la ligne en cours
            Sheets("Suivi").Range("A" & Target.Row & ":G" & Target.Row).Copy Sheets("Absents").Range("A" & Ligne)
            Sheets("Suivi").Rows(Target.Row).Delete
 
            Application.CutCopyMode = False
        Else
            MsgBox "Toutes les cellules doivent être remplies", vbInformation, "Erreur de données"
        End If
    End If
End Sub
 
Function IsValide(Ligne As Long) As Boolean
    Dim I As Long
 
    IsValide = True
 
    For I = 1 To 6
        If Cells(Ligne, I) = "" Then
            IsValide = False
            Exit For
        End If
    Next
End Function

**Accessifiante** · 01/05/2014, 17h45

En fait, mon "vrai" tableau va jusqu'à la colonne R.
Le motif d'absence est dans la colonne J.
Les colonnes obligatoirement remplies sont A, B, D, F, G et J. Les autres sont facultatives.
(Je suis capable d'adapter votre code à mes colonnes).
Le déclenchement de la macro sur le choix de l'absence serait possible mais cela impliquerait que le focus reste sur l'onglet "Absents" pour finir de remplir la ligne, le cas échéant. Même chose à l'inverse. (Car dans les colonnes suivantes j'ai des dates de départ et des dates de retour selon le cas).

Donc le code devrait supprimer les lignes filtrées dans "Suivi" mais ramener l'utilisateur à "Absents" pour qu'il finisse sa saisie... Ça fait un peu compliqué non ?

Je vais essayer vos propositions sur mon tableau test et vous en donne des nouvelles ! Merci encore !

**parmi** · 01/05/2014, 18h04

En fait, dans mon dernier code, ça se passe uniquement dans l'onglet Suivi.
Il faudra faire la même chose au niveau de la feuille Absence tout en modifiant légèrement le code
Si les données ne sont pas entrées selon la Function IsValide, ça ne fait rien du tout.
Et il n'y a plus besoin des filtres.

**Accessifiante** · 06/05/2014, 15h04

Bonjour Parmi !

J'ai été bien occupée sur un autre projet depuis la semaine dernière et je n'avais pas eu le temps de tester votre dernier code. Il me plait beaucoup mais je voudrais étendre la sélection de la ligne jusqu'à la colonne S.

J'ai donc modifié le code comme suit :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
Sheets("Suivi").Range("A" & Target.Row & ":S" & Target.Row).Copy Sheets("Absents").Range("A" & Ligne)
            Sheets("Suivi").Rows(Target.Row).Delete

Mais le message d'avertissement que toutes les cellules doivent être remplies apparaît. Je veux bien laisser ce message, mais pour les cellules A, B, D, F, G et J. Comment faire ? Également, dans le code de validation, "1 to 6" correspond à des colonnes ? A à F ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
Function IsValide(Ligne As Long) As Boolean
    Dim I As Long
 
    IsValide = True
 
    For I = 1 To 6
        If Cells(Ligne, I) = "" Then
            IsValide = False
            Exit For
        End If
    Next
End Function

Merci !

**parmi** · 06/05/2014, 16h07

On pourrait modifier la méthode en créant un tableau qui contient les numéros de colonnes à vérifier
Sans tester, ça deverait donner ceci.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Function IsValide(Ligne As Long) As Boolean
    Dim I As Long
    Dim ArrColonnes
 
    IsValide = True
    srrColonnes = Array(1, 2, 4, 6, 7, 10)    
 
    For I = 0 to UBounf(arrColonnes)
        If Cells(Ligne, arrColonnes(I)) = "" Then
            IsValide = False
            Exit For
        End If
    Next
End Function