XL 2010 Transférer une ligne, sur une autre feuille selon la valeur d'une cellule

[Acritas]

Bonjour,

J'ai deux feuilles sur mon classeur(feuille "Situation" & feuille "Entrepôt")

Selon la valeur d'une des cellules de la colonne C ( "1" ou "0") , je veux que la ligne entière bascule sur la première ligne disponible de la feuille ''Entrepôt"
et vise versa si je change la valeur d'une de ces cellules dans la feuille Entrepôt la ligne revient se coller sur la première ligne disponible de la feuille "Situation"
le tout dois se faire automatiquement sans avoir à faire exécuter le code (appuyer F5) car l'utilisateur lambda ne doit pas toucher à VBA.

Merci par avance pour votre aide

 

[Acritas]

Moi j'ai considéré que c'était le 1 puisqu'il y a des 1 dans la 1ère feuille !

pas de soucis, j'ai pris en compte
Merci beaucoup

 

[Phil69970]

@Acritas

1) Envoyer un fichier en privé est contraire à la charte

2) Expliquer qu'il est confidentiel alors que tous les éléments d'identification ont été enlevé c'est pas très logique car si tous les éléments d'identification ont été enlevés il n'est plus confidentiel il me semble !!!
Pour info une date de naissance sans le nom/prénom de la personne n'est pas un élément d'identification et il y a ~2000 naissances par jour en France !!!!

3) C'est un forum public il me semble donc les demandes en privé n'ont pas leur place ici.

4) Fournir un fichier avec une macro fait par une autre personne en expliquant que cela ne fonctionne pas c'est un peu fort de café !!!

(La macro fonctionne mais il faut lire et comprendre les commentaires que la personne qui à fait la macro à écrit !!!! )

5) Un fichier avec plus de 850 colonnes est-ce raisonnable ?

6) Le fichier du post #1 n'est en rien représentatif du fichier réel
==> 20 colonnes dans le fichier du post #1 contre plus de 850 colonnes de le vrai fichier j'appelle pas cela représentatif

Bref pour une première demande je conseillerais à @Acritas d'aller lire la charte ==> ici

Bonne lecture

@Phil69970

 

[job75]

Si l'on veut transférer d'un seul coup toutes les lignes de valeurs 0 en colonne C, la méthode la plus rapide est d'utiliser des tableaux VBA, voyez ce fichier (3) :

Sub Transfert()
Dim ncol%, Sh As Worksheet, Sh1 As Worksheet, Sh2 As Worksheet, ShDest As Worksheet, tablo, resu(), i&, n&, j%, nn&
ncol = 20 'nombre de colonnes
Set Sh = ActiveSheet
Set Sh1 = Sheets("Situation ") 'pourquoi un espace ???
Set Sh2 = Sheets("Entrepôt")
If Sh.Name = Sh1.Name Then Set ShDest = Sh2
If Sh.Name = Sh2.Name Then Set ShDest = Sh1
If ShDest Is Nothing Then Exit Sub
If Sh.FilterMode Then Sh.ShowAllData 'si la feuille est filtrée
With Sh.Range("B5:B" & Sh.Range("E" & Sh.Rows.Count).End(xlUp).Row).Resize(, ncol)
    If .Row < 5 Then Exit Sub 'si le tableau est vide
    tablo = .FormulaR1C1 'matrice, plus rapide
    ReDim resu(1 To UBound(tablo), 1 To ncol)
    For i = 1 To UBound(tablo)
        If tablo(i, 2) = 0 Then 'critère 0 en colonne C
            n = n + 1
            For j = 1 To ncol
                tablo(n, j) = tablo(i, j)
            Next j
        Else
            nn = nn + 1
            For j = 1 To ncol
                resu(nn, j) = tablo(i, j)
            Next j
        End If
    Next i
    '---restitution en 1ère feuille---
    Application.ScreenUpdating = False
    .Borders.LineStyle = xlNone 'efface toute bordure
    If nn Then
        .Resize(nn).FormulaR1C1 = resu
        .Resize(nn).BorderAround Weight:=xlMedium 'pourtour
        .Borders(xlEdgeTop).LineStyle = xlNone
    End If
    If nn < .Rows.Count Then
        With .Rows(nn + 1).Resize(.Rows.Count - nn)
            .ClearContents 'RAZ sous le tableau
            .Interior.ColorIndex = xlNone 'efface  les couleurs
            .Columns(2).Validation.Delete
        End With
    End If
End With
'---restitution en 2ème feuille---
If ShDest.FilterMode Then ShDest.ShowAllData 'si la feuille est filtrée
i = ShDest.Range("E" & ShDest.Rows.Count).End(xlUp).Row + 1
If n Then
    With ShDest.Cells(i, 2).Resize(n, ncol)
        .FormulaR1C1 = tablo
        .BorderAround Weight:=xlMedium 'pourtour
        .Borders(xlEdgeTop).LineStyle = xlNone
        .Columns(2).Validation.Delete
        .Columns(2).Validation.Add xlValidateList, Formula1:="0,1"
        With Union(.Columns(7), .Columns(11), .Columns(15), .Columns(19), .Columns(20))
            .Interior.Color = .Cells(0, 1).Interior.Color 'fond gris
            .Font.Bold = True 'gras
            .Font.Color = vbBlack 'police noire
            .HorizontalAlignment = xlCenter 'centrage
        End With
        .Columns(20).Font.Color = vbWhite 'police blanche
    End With
    Application.Goto ShDest.Cells(i, 2) 'facultatif
End If
End Sub

Les tableaux sont restitués formatés et sans lignes vides.

Edit : ajouté le traitement des listes de validation en colonne C.

Bonne nuit.

 

[Acritas]

@Acritas

1) Envoyer un fichier en privé est contraire à la charte

Regarde la pièce jointe 1164986

2) Expliquer qu'il est confidentiel alors que tous les éléments d'identification ont été enlevé c'est pas très logique car si tous les éléments d'identification ont été enlevés il n'est plus confidentiel il me semble !!!
Pour info une date de naissance sans le nom/prénom de la personne n'est pas un élément d'identification et il y a ~2000 naissances par jour en France !!!!

Regarde la pièce jointe 1164989

3) C'est un forum public il me semble donc les demandes en privé n'ont pas leur place ici.

4) Fournir un fichier avec une macro fait par une autre personne en expliquant que cela ne fonctionne pas c'est un peu fort de café !!!

Regarde la pièce jointe 1164990
(La macro fonctionne mais il faut lire et comprendre les commentaires que la personne qui à fait la macro à écrit !!!! )

5) Un fichier avec plus de 850 colonnes est-ce raisonnable ?

6) Le fichier du post #1 n'est en rien représentatif du fichier réel
==> 20 colonnes dans le fichier du post #1 contre plus de 850 colonnes de le vrai fichier j'appelle pas cela représentatif

Bref pour une première demande je conseillerais à @Acritas d'aller lire la charte ==> ici

Bonne lecture

@Phil69970

Bonsoir Phil69970 :

J'ai précisé depuis le départ que j'étais totalement novice en VBA, cella implique aussi l'utilisation de forum...ce n'est qu'hier que j'ai posté sur un forum pour la toute première fois de toute ma vie... et j'ai déjà bien plus 'un certain age... en tout cas je suis plus tout jeune...
Qu'à cella ne tienne, je crois avoir eu la chance du débutant... j'ai suivis les différentes orientations qui m'étaient données y compris en message privé et j'ai réussis à avoir le rendu que je voulais, bien bien loin des démarches de calculs spécifiques de formules... je ne demandais que la copie d'une lignes vers une autre feuille en fonction de la valeur d'une cellule de cette ligne et... quelqu'un me l'a donné du premier coup sans question, sans moults commentaires...(je reviendrais clore le post et le remercier et donner à tous le code qui à marché en publiant le fichier qui est bien celui que j'ai posté ici et qui a permis de réussir mon objectif), la seule chose c'est qu'utilisant VBA depuis hier, j'ignorais totalement où mettre ce code...

j'espère qu'à l'avenir, quand quelqu'un t'écrit en privé tu l'engèlera en privé !

je reste courtois car je suis nouveau et ne connais vraiment pas les usages de ce forum qui m'a permis de régler un soucis... du coup je veux y rester

 

[Acritas]

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
   Dim LSrc As Long, LDst As Long
   If Target.Count > 1 Then Exit Sub ' Si la plage changée comporte plusieurs cellules on sort.
   If Intersect(Me.[C5].Resize(Me.[C1000000].End(xlUp).Row - 4), Target) Is Nothing Then Exit Sub
      ' Si la cellule changée n'est pas comprise dans la plage commençant à C5 pour un nombre de ligne égal
      ' au numéro de ligne de la dernière cellule renseignée diminué de 4, on sort.
   If Target.Value <> 0 Then Exit Sub ' si la cellule changée ne vaut pas 0 on sort.
   Application.EnableEvents = False ' Désactive les évènements pour ne pas provoquer d'appel récursif de Sub Worksheet_Change
   LSrc = Target.Row ' Ligne de la cellule changée
   LDst = Feuil2.[B1000000].End(xlUp).Row + 1 ' Ligne destinatrice après celle de la dernière renseignée
   If LDst < 5 Then LDst = 5 ' au moins 5 si tout est vide
   Feuil2.Rows(LDst).Insert ' Insersion ligne
   Me.Rows(LSrc).EntireRow.Cut Feuil2.Rows(LDst) ' Couper/Coller le contenu
   Me.Rows(LSrc).Delete xlShiftUp ' Supprimer la ligne source
   Application.EnableEvents = True ' Rétablit les évènements
   End Sub

@Dranreb

merci beaucoup de ton retour et de la patience prise pour m'aider dans ma recherche, cela fait deux semaines que je suis dessus et ça commençait vraiment à être chaud sur moi... j'avais intérêt à produire du résultat... demain, enfin ce matin dans 4 heures c'était mon ultimate day for end the game...

Oui, le fichier ta solution pour régler ma demande du fichier non représentatif de 20 colonnes a permis de gérer un fichier de 800 colonnes enfin je crois même qu'il y en a plus...
bon les puristes vont s'arracher les cheveux mais... dites vous seulement que j'au eu a bénéficier de la chance du débutant...

je vous communique donc le fichier qui marche aussi bien sur 20 colonnes que sur plus de 800 colonnes

une dernière question sur ce post : comment fait-on pour mettre en évidence la bonne réponse et reconnaitre le soutient de quelqu'un? c'est vraiment un début pour moi!!!

 

[Acritas]

Bonjour @Acritas et bienvenu sur XLD

Je te propose cette version

Merci de ton retour

@Phil69970

 

[job75]

Bonjour Acritas, le forum,

La solution de Dranreb que vous utilisez présente 2 inconvénients :

- elle ne traite qu'une seule cellule à la fois, ce sera pénible s'il faut transférer 1000 lignes ou plus

- les tableaux ne sont pas formatés correctement (bordures).

A+

 

[job75]

S'il faut inverser le critère de transfert entre les 2 feuilles utiliser la variable critere, fichier (4) :

If tablo(i, 2) = critere Then 'critère en colonne C

Mais ça ne me paraît pas vraiment nécessaire.

 

[Acritas]

Dans le classeur ci-joint,
les tables ont été converties en tables structurées de nom "situation" et "entrepot" .
Le menu contextuel accessible par clic droit sur une des lignes des tables vous permettra de faire les transferts.
Les formules sont respectées.Regarde la pièce jointe 1164988

Bonjour @franch55

j'avoue ne pas avoir essayer d'utiliser ta solution vu le niveau d'urgence que j'avais, maintenant que je suis plus calme, je test toutes les solutions qui m'ont été proposées cependant je ne vois pas le menu contextuel proposé dans ton fichier.

Peux-tu s'il te plaît renvoyer le fichier en ayant déjà rendu la macro fonctionnelle dans ton fichier(j'avoues que j'ignore quoi faire pour)?

Par ailleurs dès que je protège l'onglet, et/le classeur, les macros ne fonctionne plus,

Comment faire pour que cette macro de VBA bypass la restriction en écriture par mot de passe sur une feuille et/ou le classeur?

En français facile je souhaite rendre inopérant pour l'utilisateurs lambda, l'accès aux formules de calculs(multiples) et au mises en formes conditionnelles(également multiples)

Merci par avance de votre aide

 

[fanch55]

Bonjour @franch55

j'essaie d'utiliser ta solution, cependant je ne vois pas le menu contextuel proposé. peux-tu s'il te plaît renvoyer le fichier en ayant activé la macro(j'avoues que j'ignore quoi faire pour)

Le menu contextuel accessible par clic droit sur une des lignes des tables vous permettra de faire les transferts.

 

[Acritas]

Regarde la pièce jointe 1165221

Merci bien!! j'ai vu ! j'ai aussi vu que tu as rajouté un bouton ''transfert des valeurs 1''

j'essaie sur le fichier définitif et te reviens ?

En mettant un mot de passe sur les feuille ça marchera aussi?


comment faire pour déplacer ton bouton ? et le mettre au niveau de la cellule A2?

 

[Acritas]

Oka

Merci bien!! j'ai vu ! j'ai aussi vu que tu as rajouté un bouton ''transfert des valeurs 1''

j'essaie sur le fichier définitif et te reviens ?

En mettant un mot de passe sur les feuille ça marchera aussi?


comment faire pour déplacer ton bouton ? et le mettre au niveau de la cellule A2?

Okay j'ai vu et compris! on sélectionne le bouton par clic droit et on le déplace tout simplement

quel serait la variant du code si les cellules conservaient leur mise en forme d'origine ?

 

[Acritas]

Regarde la pièce jointe 1165221

Besoin d'une variante de code qui n'agit pas sur la mise en forme originale des cellules

 

[fanch55]

Merci bien!! j'ai vu ! j'ai aussi vu que tu as rajouté un bouton ''transfert des valeurs 1''

Ce ne doit pas être mon classeur ? ( aucun bouton )

En mettant un mot de passe sur les feuille ça marchera aussi

Un mot de passe en Excel est illusoire au point de vie sécurité
car il peut être craqué et bypasser très facilement.
Si toutefois vous voulez quand même protéger la feuille, le classeur joint en tient compte .

comment faire pour déplacer ton bouton ? et le mettre au niveau de la cellule A2?

????

 

[Acritas]

Besoin d'une variante de code qui n'agit pas sur la mise en forme originale des cellules

Ce ne doit pas être mon classeur ? ( aucun bouton )

Regarde la pièce jointe 1165223

Regarde la pièce jointe 1165224

Un mot de passe en Excel est illusoire au point de vie sécurité
car il peut être craqué et bypasser très facilement.
Si toutefois vous voulez quand même protéger la feuille, le classeur joint en tient compte .



????

très bien je regarde et te reviens