Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

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

Acritas

XLDnaute Nouveau
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
 

Pièces jointes

  • Fichier de Test.xlsx
    18.4 KB · Affichages: 13

Acritas

XLDnaute Nouveau
Qu'entendez-vous par mise en forme ?
  • Format de présentation du contenu
  • Couleur des cellules
  • Largeur des cellules

  • Format de présentation du contenu
  • Couleur des cellules
  • Largeur des cellules
  • les formules de calculs(également)--> les cellules sont copiés tel qu'elle... j'ai au préalable, fait la mise en forme dans l'onglet de destination ainsi que positionné exactement au même endroit les cellules qui servent à effectuer les calculs
 

fanch55

XLDnaute Barbatruc
Pour avoir une identité visuelle, j'avais différencié les couleurs des 2 tables.
Classeur corrigé .
 

Pièces jointes

  • Fichier de Test F55.xlsm
    39.8 KB · Affichages: 3

job75

XLDnaute Barbatruc
Bonjour Acritas, le fil,

La solution de mon fichier (4) ne semble pas avoir de succès.

Peut-être parce qu'elle paraît trop compliquée.

Dans ce fichier (5) en voici une autre, plus simple, qui utilise un tri de regroupement et le couper-coller :
VB:
Sub Transfert()
Dim ncol%, Sh As Worksheet, Sh1 As Worksheet, Sh2 As Worksheet, ShDest As Worksheet, critere As Byte, n&, i&, j&, rc&
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: critere = 0
If Sh.Name = Sh2.Name Then Set ShDest = Sh1: critere = 1
If ShDest Is Nothing Then Exit Sub
If Sh.FilterMode Then Sh.ShowAllData 'si la feuille est filtrée
If ShDest.FilterMode Then ShDest.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
    n = Application.CountIf(.Columns(2), critere)
    If n = 0 Then Exit Sub
    Application.ScreenUpdating = False
    .Sort .Columns(2), IIf(critere = 0, xlDescending, xlAscending), Header:=xlNo 'tri pour regrouper et accélérer
    .Borders.LineStyle = xlNone 'efface toute bordure
    i = Application.Match(critere, .Columns(2), 0)
    j = ShDest.Range("E" & ShDest.Rows.Count).End(xlUp).Row + 1
    rc = .Rows.Count 'mémorise
    .Rows(i).Resize(n).Cut ShDest.Cells(j, 2) 'couper-coller
    If n < rc Then
        .BorderAround Weight:=xlMedium 'pourtour
        .Borders(xlEdgeTop).LineStyle = xlNone
    End If
End With
With ShDest.Cells(j, 2).Resize(n, ncol)
    .BorderAround Weight:=xlMedium 'pourtour
    .Borders(xlEdgeTop).LineStyle = xlNone
End With
ShDest.Activate 'facultatif
End Sub
Pour tester j'ai recopié le tableau de la 1ère feuille sur 51 000 lignes, durées d'exécution chez moi :

- fichier (4) => 5,9 secondes

- fichier (5) => 7,6 secondes, c'est un peu moins rapide.

A+
 

Pièces jointes

  • Fichier de Test(5).xlsm
    32.3 KB · Affichages: 5

Acritas

XLDnaute Nouveau
@job75,

Je suis entrain de regarder les différentes solution en essayant d'apprendre par la même occasion.

Question 1 : est-il possible d'avoir plus de détails possibles sur les différentes lignes de code ?

Question 2 : Se pose désormais une problématique de verrouillages en écriture des différents onglets, quel serait la variante de ton code ?

Question 3 : je vois que ton code prend en compte le ''pourtour'' qu'en serait-il si tu retirais cette contrainte?

Question 4 : quel est le sens de cette ligne de code : If .Row < 5 Then Exit Sub je la vois dans différents codes

Question 5 : Quelle est la ligne de code en rapport avec votre bouton de transfert des données ?
 
Dernière édition:

job75

XLDnaute Barbatruc
Q1 : non, car il faudrait expliquer chaque mot, faites des recherches sur le web.

Q2 : si les feuilles sont protégées il faut les déprotéger en début de macro avec les codes :
VB:
Sh.Unprotect "toto" 'mot de passe
ShDest.Unprotect "toto"
et les protéger en fin de macro.

Q3 : c'est pour appliquer des bordures sur le pourtour de la plage, on peut ne pas en mettre.

Q4 : si le tableau est vide .Row = 4 donc ce code arrête la macro.

Q5 : la macro fonctionne avec les 2 boutons, ce sont les définitions de Sh et ShDest qui distinguent les feuilles.
 

Acritas

XLDnaute Nouveau
@Dranreb

Te serait-il possible de permettre dans ton code la prise en compte d'un mot de passe verrouillant les cellules au départ et à l'arrivée ?

merci bien !
 

Acritas

XLDnaute Nouveau
S'il vous plait, quelqu'un, peut-il m'aider à permettre à la macro suivante de s'exécuter indépendamment d'un mot de passe? protégeant chacune des feuilles concernées?


Alors vous avez oublié de mettre le code pour la déprotéger...
'ignore comment le faire ... je suis en début d'apprentissage
 

Pièces jointes

  • A- Fichier de Test.xlsm
    27.3 KB · Affichages: 0

Acritas

XLDnaute Nouveau
j'ai trouvé le code suivant :

/
VB:
Private Sub Workbook_Open()
  Dim sh As Worksheet
  For Each sh In Sheets
    sh.Protect Password:="MDP", userinterfaceonly:=True
  Next sh
End Sub
et

Private Sub Workbook_BeforeClose(Cancel As Boolean)
  Dim sh As Worksheet
  For Each sh In Sheets
    sh.UnProtect Password:="MDP", userinterfaceonly:=False
  Next sh
End Sub

--> Dans le module ThisWorkbook . Cella vous semble-t-il correcte être adapté et opportun ?

Merci bien
 

Discussions similaires

Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…