Modif macro

Le 30/07/2019 à 12:20

bonjour à tous,

après une recherche j'ai trouvé une macro qui me permet de :

analyser une feuille nommée "BASE" et de copier les lignes contenant une info dans la colonne "H" dans un onglet portant le même nom qu'il y a dans cette colonne.

le problème est de deux ordres:

1 - il faudrait effacer la ligne transférée et décaler les autre lignes vers le haut pour éviter les lignes vides et d'avoir la même ligne dans deux onglets différents.

2 - pouvoir étendre la manip sur tout les onglets car une ligne qui passe dans un autre onglet est susceptible de changer d'état et donc doit être transférée dans l'onglet correspondant.

exemple une ligne dans "A sortir" peut changer et passer en "Déja présents" donc il faudra la mettre dans le bon onglet.

une dernière chose là je test sur 3 onglet mais il risque d'en avoir plus donc il faut que la macro s'adapte à l'ajout de nouveaux onglets.

dans la macro il efface les onglets avant de traité mais dans mon cas il ne faut pas le faire car c'est juste un transfère de ligne.

il faut analyser la case "H" dans chaque onglet et transférer chaque ligne dans le bon onglet.

je vous joint mon fichier.

à l'avance un grand merci pour votre aide.

8changement-d-onglet.xlsm (21.13 Ko)

Le 30/07/2019 à 13:17

bon mon explication est un peu compliquée

pour faire simple :

j'ai des onglets nommés avec des données dedans

dans la colonne "H" de chaque onglet je retrouve des noms qui correspondent au nom d'onglet.

je veux pouvoir, en appuyant sur le bouton, que les lignes se déplacent dans l'onglet correspondant au nom en "H" et remonter les autres pour ne pas avoir de lignes vident.

c'est une sorte de tri.

voila je pense plus clair

Le 31/07/2019 à 06:32

bonjour,

Personne pour me venir en aide sniffffffffffffffffff?

Bonne journée à tous

Le 31/07/2019 à 13:03

personne pour une piste?

Le 01/08/2019 à 06:32

Bonjour,

je crois que je vais fermer ce post dans la matinée pour ne pas encombrer.

merci à ceux qui ont pris le temps de me lire et de mon coté je vais continué à chercher et si je trouve je post la solution.

Bonne journée à tous

Le 01/08/2019 à 10:31

Bonjour,

un essai:

juste rajouter la mise en tableau( Taberr) des lignes ni "Déjà présent" ni "A sortir" , au cas où...

puis effacement feuille base et recopie du tableau Taberr

Sub Séparer()
    With Worksheets("base")
    tablo = .Range("A2:J" & .Range("A" & Rows.Count).End(xlUp).Row)
    kDP = 1
    kAS = 1
    Kerr = 1
    For i = 1 To UBound(tablo, 1)
        If tablo(i, 8) = "Déjà présent" Then
            ReDim Preserve TabloDP(1 To 10, 1 To kDP)
            For j = 1 To 10
                TabloDP(j, kDP) = tablo(i, j)
            Next j
            kDP = kDP + 1

        ElseIf tablo(i, 8) = "A sortir" Then
            ReDim Preserve tabloAS(1 To 10, 1 To kAS)
            For j = 1 To 10
                tabloAS(j, kAS) = tablo(i, j)
            Next j
            kAS = kAS + 1
        Else
            ReDim Preserve Taberr(1 To 10, 1 To Kerr)
            For j = 1 To 10
                Taberr(j, Kerr) = tablo(i, j)
            Next j
            Kerr = Kerr + 1
        End If
    Next i
    .Range("A2").Resize(UBound(tablo, 1), UBound(tablo, 2)).ClearContents
    .Range("A2").Resize(UBound(Taberr, 2), 10) = Application.Transpose(Taberr)
    End With
    Sheets("A sortir").Range("A1").CurrentRegion.Offset(1, 0).ClearContents
    Sheets("A sortir").Range("A2").Resize(UBound(tabloAS, 2), 9) = Application.Transpose(tabloAS)
    Sheets("Déja présents").Range("A1").CurrentRegion.Offset(1, 0).ClearContents
    Sheets("Déja présents").Range("A2").Resize(UBound(TabloDP, 2), 9) = Application.Transpose(TabloDP)
    MsgBox "Travail terminé."
End Sub

ne pas oublier de déclarer les nouvelles variables au même endroit que celles existante (il doit bien y avoir une raison pour les avoir déclarées en global )

A+

Le 01/08/2019 à 11:32

Merci beaucoup je viens de tester et c'est top juste quelque petites modifs à faire mais je vais m'en sortir.

Le 01/08/2019 à 12:19

Bonjour,

je ré-ouvre le sujet car il me manque une chose:

la macro fait bien le travail mais juste avec la feuille "BASE"

je voudrais pouvoir faire la même chose avec toutes les feuilles du classeur sauf la feuille "CONFIG".

une autre chose n'effacer que les données qui sont déplacées car là elle efface toute les données de le feuille de destination.

et je veux que les lignes se cumulent.

le fichier est destiné à une production en différentes étapes qui sont représentée par le nom de chaque feuille donc la ligne se déplace suivant l'étape à réaliser dans la feuille correspondante comme cela chaque intervenant voit les chose à faire sur son étape et quand c'est fini il change l'état pour que cela bascule dans une autre étape.

à l'avance merci

Option Explicit

Dim tablo, tabloAS(), TabloDP(), Taberr(), i&, j&, kDP&, kAS&, Kerr&

Sub Séparer()
    With Worksheets("base")
    tablo = .Range("A2:J" & .Range("A" & Rows.Count).End(xlUp).Row)
    kDP = 1
    kAS = 1
    Kerr = 1
    For i = 1 To UBound(tablo, 1)
        If tablo(i, 8) = "Déjà présents" Then
            ReDim Preserve TabloDP(1 To 10, 1 To kDP)
            For j = 1 To 10
                TabloDP(j, kDP) = tablo(i, j)
            Next j
            kDP = kDP + 1

        ElseIf tablo(i, 8) = "A sortir" Then
            ReDim Preserve tabloAS(1 To 10, 1 To kAS)
            For j = 1 To 10
                tabloAS(j, kAS) = tablo(i, j)
            Next j
            kAS = kAS + 1
        Else
            ReDim Preserve Taberr(1 To 10, 1 To Kerr)
            For j = 1 To 10
                Taberr(j, Kerr) = tablo(i, j)
            Next j
            Kerr = Kerr + 1
        End If
    Next i
    .Range("A2").Resize(UBound(tablo, 1), UBound(tablo, 2)).ClearContents
    .Range("A2").Resize(UBound(Taberr, 2), 10) = Application.Transpose(Taberr)
    End With
    Sheets("A sortir").Range("A1").CurrentRegion.Offset(1, 0).ClearContents
    Sheets("A sortir").Range("A2").Resize(UBound(tabloAS, 2), 9) = Application.Transpose(tabloAS)
    Sheets("Déjà présents").Range("A1").CurrentRegion.Offset(1, 0).ClearContents
    Sheets("Déjà présents").Range("A2").Resize(UBound(TabloDP, 2), 9) = Application.Transpose(TabloDP)
    MsgBox "Travail terminé."
End Sub

Le 01/08/2019 à 12:43

Bonjour à tous,

Ce n'est pas clair ...

Est-ce que tu veux que la macro fonctionne sur n'importe quelle feuille (excepté CONFIG) ?

Ou ...

Si tu veux qu'en lançant la macro, elle fasse le tour des feuilles (excepté CONFIG) ?

ric

Le 01/08/2019 à 12:51

elle fasse le tour des feuilles (excepté CONFIG).
ne pas effacer la feuille de destination sinon je perds les données déjà présentes.(là elle efface tout avant de transférer)
conserver l'intégralité des cases car dans certaine il va y avoir des menus déroulant pour par exemple changer le choix en H pour qu'au prochain lancement de la macro la ligne change de feuille.(si je met une case de la ligne à déplacer avec un menu déroulant quand la ligne est déplacée le menu disparais).

Merci

Le 01/08/2019 à 14:15

Bonjour à tous,

danval a écrit :
... - conserver l'intégralité des cases car dans certaine il va y avoir des menus déroulant pour par exemple changer le choix en H pour qu'au prochain lancement de la macro la ligne change de feuille.(si je met une case de la ligne à déplacer avec un menu déroulant quand la ligne est déplacée le menu disparais) ...

J'avoue ne pas bien comprendre ce dernier énoncé. Donc, je n'en ai pas tenu compte.

Pour le reste ...

Un essai ...

ric

3changement-d-onglet-v3.xlsm (27.98 Ko)

Le 01/08/2019 à 14:48

super mais encore 3 erreurs (désolé):

les données sont copiées deux fois dans la feuille "Déjà présents" .
les lignes déplacées ne sont pas effacées de la feuille analysée. (une ligne déplacée doit disparaître de sa feuille d'origine et les lignes dessous doivent remonter pour combler la ligne vide)
les feuilles "A sortir" et "Déjà présents" ne sont pas analysées. par exemple une ligne dans la feuille "A sortir" peut passer dans l'état Déjà présents et doit être mise dans la feuille "Déjà présents".

pour ce que tu n'as pas compris:

si dans une case dans une ligne à déplacée qui contient par exemple un menu déroulant et bien quand tu regarde la ligne dans la nouvelle feuille la case ne contient plus le menu déroulant?

merci

Le 01/08/2019 à 14:56

Bonjour à tous,

Un essai ...

ric

3changement-d-onglet-v4.xlsm (27.86 Ko)

Le 01/08/2019 à 14:57

Bonjour à tous,

Pour les menus déroulants ... peux-tu soumettre un exemple ?

ric

Le 01/08/2019 à 15:22

voila

dans le fichier les colonnes "H" des deux feuilles base et base2 contiennent un menu déroulant.

quand on exécute la macro et que l'on va voir la colonne "H" de "A sortir" par exemple et bien le menu a disparu on ne peut plus changer l'état.

SINON POUR LE RESTE UNE MERVEILLE UN GRAND MERCI VRAIMENT UN SITE AU TOP

3changement-d-onglet-v4.xlsm (24.64 Ko)

Le 01/08/2019 à 16:33

Bonjour à tous,

Un essai ...

ric

3changement-d-onglet-v5.xlsm (26.09 Ko)

Le 01/08/2019 à 16:36

je viens de tester alors chapeau bas tout fonctionne à merveille.

un énorme merci pour ce travail qui va me servir sur plusieurs fichiers

bonne continuation.

Le 01/08/2019 à 16:37

ric

Le 02/08/2019 à 09:08

Bonjour,

j'essais de modifier la macro pour la faire fonctionner dans mon fichier et je n'y arrive pas toujours des erreurs.

les différences sont :

le nombre de colonnes
le départ du tableau en B2 au lieu de A2
le nom des feuilles (déja corrigé)
la colonne pour le test de changement : colonne "O" au lieu de "H".

je n'y comprend rien grrrrrrrrr j'ai passé une grosse partie de la soirée pour n'aboutir à rien je suis dépité.

le fichier d'origine fonctionne à merveille.

je joint le fichier d'origine et mon fichier.

4fichier-origine.xlsm (26.09 Ko)

6mon-fichier.xlsm (27.38 Ko)

Le 02/08/2019 à 11:09

Bonjour,

si les données ne sont plus à la même place qu'initialement, modifier la plage du tableau Tablo pour que ça coïncide :

                tablo = .Range("A2:J" & .Range("A" & Rows.Count).End(xlUp).Row) 'avant
                tablo = .Range("B2:P" & .Range("B" & Rows.Count).End(xlUp).Row) 'après

.Range("A" & Rows.Count).End(xlUp).Row donne la dernière ligne "utile" des données.... s'il y a des données en colonne A.

Puisque les données sont déportées en col B: .Range("B" & Rows.Count).End(xlUp).Row

si la colonne à tester n'est plus H mais O, modifier tous les tests:

                    If tablo(i, 8) = "EN COURS" Then 'avant
                    If tablo(i, 13) = "EN COURS" Then 'après

Dans tablo(i, 13) 13 correspond à la colonne 13 de tablo qui lui commence en colonne B donc 13= colonne O des données.

Modifier également tous les ReDim Preserve pour conserver toutes les données:

'ReDim Preserve TabloDP(1 To 10, 1 To kDP)

ReDim Preserve TabloDP(1 To 14, 1 To kDP)
'ou
ReDim Preserve TabloDP(1 To UBound(tablo, 2), 1 To kDP) ' qui évite de corriger le code si on modifie le nb de colonnes initial

Dernier point (a priori) , modifier A en B dans toutes les lignes d'écriture:

               ' dlig = Worksheets("ATTENTE PIECES").Cells(Rows.Count, "A").End(xlUp).Row + 1
                'Worksheets("ATTENTE PIECES").Range("A" & dlig)..........
                dlig = Worksheets("ATTENTE PIECES").Cells(Rows.Count, "B").End(xlUp).Row + 1
                Worksheets("ATTENTE PIECES").Range("B" & dlig)..........

A+