Créer une fonction de copie de colonne vers colonne de même nom

Bonjour !

Je suis nouveau dans ce forum. Et, houlàlà ! Il est très bien fait. Léger donc chargement très rapide pour des connexions bas débits comme chez nous qui sommes encore très très loin des zones urbaines. Permettez que j’en félicite les administrateurs.

Alors, j’ai écrit un premier bout de code qui me permet de copier 2 colonnes à chaque feuille dont le nom commence par une certaine chaine «ListeClasse - » et les recopie dans un tableau d’une autre feuille nommée « TOUT CLASSE ACTUELLE »:

Sub ReunirListesClasses()

    Dim DebutPlageCopiee, FinPlageCopiee, nbCellulesCopiees As Long
    Dim DebutPlageDestination, FinPlageDestination As Long
    Dim PlageCopieeB, PlageCopieeP As String
    Dim Ws As Worksheet

    Sheets("TOUTE CLASSE ACTUELLE").Select
    Range("E5:E1000").Clear
    Range("G5:G1000").Clear

    DebutPlageDestination = 5
    FinPlageDestination = 5
    For Each Ws In ThisWorkbook.Worksheets
        With Ws
            DebutPlageCopiee = 3
            nbCellulesCopiees = 0
            If .Name Like "ListeClasse - *" Then

                While .Range("B" & (DebutPlageCopiee + nbCellulesCopiees)).Value <> ""
                    nbCellulesCopiees = nbCellulesCopiees + 1
                Wend
                FinPlageCopiee = DebutPlageCopiee + nbCellulesCopiees - 1

                PlageCopieeB = "B" & DebutPlageCopiee & ":B" & FinPlageCopiee
                Ws.Select
                .Range(PlageCopieeB).Select
                Selection.Copy
                Sheets("TOUTE CLASSE ACTUELLE").Select
                Range("E" & DebutPlageDestination).Select
                Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                        :=True, Transpose:=False

                PlageCopieeP = "P" & DebutPlageCopiee & ":P" & FinPlageCopiee
                Ws.Select
                .Range(PlageCopieeP).Select
                Selection.Copy
                Sheets("TOUTE CLASSE ACTUELLE").Select
                Range("G" & DebutPlageDestination).Select
                Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                        :=True, Transpose:=False

                DebutPlageDestination = DebutPlageDestination + nbCellulesCopiees
            End If
        End With
    Next Ws
End Sub

Cela marche très bien déjà. Mais, reste encore trop basic. J'ai donc en idée d'écrire la fonction ci-après:

Sub Copier_Col_A_Col(FeuilleDestination As Worksheet, DebutDesFeuillesAcopier As String, ColonneAcopier As String) où :
- FeuilleDestination : ' est le nom de la feuille qui reçoit les données copiées ;
- DebutDesFeuillesAcopier : ' est la chaine commune qui débute le nom des autres feuilles où chercher les données ;
- ColonneAcopier : ' est le nom de la colonne, dans les feuilles dont le nom commencerait par DebutDesFeuillesAcopier, qu’il faudrait trouver et copier.

qui une fois lancée copierait les cellules (non vide) de la Bonne colonne (ColonneAcopier ) et les collerait, à la suite des données la colonne de même nom, dans la feuille de destination.

N'étant pas très familier avec la manipulation des objets en VBA, je me suis complètement planter (c'est tout un cafouillage ! ) avec le code que voici :

Sub Copier_Col_A_Col(FeuilleDestination As Worksheet, DebutDesFeuillesAcopier As String, ColonneAcopier As String)

    Dim DebutPlageCopiee, FinPlageCopiee, nbCellulesCopiees As Long
    Dim DebutPlageDestination, FinPlageDestination As Long
    Dim PlageCopieeB, PlageCopieeP As String
    Dim Ws As Worksheet

    ' ATTENTION ! on doit sélectionner la colonne de destination puis effacer les données 
    ' sans toucher au titre de la colonne
    ' Déjà à ce niveau, mon code n'efface que le titre de la colonne
     :( 
    FeuilleDestination.Select
    Set PlageDestination = FeuilleDestination.Cells.Find(what:=ColonneAcopier, LookIn:=xlValues, lookat:=xlWhole) 
    PlageDestination.Select
    PlageDestination.Clear 

    For Each ClasseurCopie In ThisWorkbook.Worksheets
        With ClasseurCopie
            DebutPlageCopiee = 3 ' tout ça est très basic je pense
            If .Name Like DebutDesFeuillesAcopier Then
                With .Cells
                    Set PlageCopiee = .Find(what:=ColonneAcopier, LookIn:=xlValues, lookat:=xlWhole)

                    If PlageCopiee Is Nothing Then Exit Sub ' hein ! et les autres feuilles ???
                    plagecopieeCol = PlageCopieeB.Column
                    DebutPlageCopiee = PlageCopiee.End(xlUp).Row
                End With

                Set PlageDestination = .Cells(DebutPlageCopiee, plagecopieeCol).Resize(.Cells(.Rows.Count,  _
                        plagecopieeCol).End(xlUp).Row - 1)
                nbCellulesCopiees = PlageDestination.Rows.Count
                PlageDestination.Copy Destination:=ClasseurDestination.Cells(DebutPlageDestination, FinPlageDestination)
                DebutPlageDestination = DebutPlageDestination + nbCellulesCopiees
            End If
        End With
    Next ClasseurCopie
End Sub

Merci de bien vouloir me guider

Bonsoir zot,

c'est très bien d'avoir donné de nombreuses explications et d'avoir placé ton code VBA entre balises, mais ce serait bien mieux avec ton fichier (sans données confidentielles) ; pour cela, utilise le bouton « Ajouter des fichiers » (situé sous la fenêtre d'édition de ton post).

dhany

Merci dhany pour ta réponse.

Alors, ci-joint le fichier.

PS: L'intérêt de cette nouvelle fonction est de récupérer la bonne colonne dans un amas de colonne dont l'ordre n'est pas toujours respecter dans les autres feuilles. Merci

Bonjour zot,

je te retourne ton fichier modifié :

Ctrl r lance la macro RéunirListesClasses (réécrite très différemment)

Ctrl e lance la macro effacer (inchangée)

Alt F11 pour voir le code VBA, puis revenir sur Excel


je n'ai pas fait ton PS car tu dois être plus explicite ! récupérer la bonne colonne ; laquelle ? une seule ?

chacune des 3 colonnes "NOM & PRENOMS" ; "MATRICULE" ; "NIVEAU" ? autre ?


surtout, tu dois joindre un fichier représentatif : la ou les colonne(s) doivent être dans le désordre (car ordre non respecté) ;

ça permettra de vérifier si la macro à réaliser fait bien son travail et trouve la bonne colonne parmi l'amas des autres.

dhany

Bonjour dhany ,

Merci ! Tes modifications sont bonnes et rendent l'extraction des données plus naturelles pour l'utilisateur.

Mais, cette 1ère procédure bien qu'elle fonctionne ne marchera pas dans les cas où les colonnes ne sont pas dans le bon ordre.

Pour preuve, et comme tu le souhaitais, j'ai chargé un autre fichier avec des colonnes dans le désordre. Et tu verras bien la non cohérence du remplissage...

Tu demandais:

je n'ai pas fait ton PS car tu dois être plus explicite ! récupérer la bonne colonne ; laquelle ? une seule ?

Oui. Une seule colonne: La COLONNE_A_COPIER spécifiée dans le paramètre de la nouvelle fonction (à écrire).

chacune des 3 colonnes "NOM & PRENOMS" ; "MATRICULE" ; "NIVEAU" ? autre ?

En fait, la nouvelle fonction doit avoir 3 paramètres:

- Dim FEUILLE_DESTINATION As Worksheet '  Cest le nom de la feuille qui reçoit les données copiées ;
- Dim DEBUT_DES_FEUILLES As String ' Cest la chaîne commune qui débute le nom des autres feuilles où chercher les données ;
- Dim COLONNE_A_COPIER As String ' Cest le nom de la colonne, dans les feuilles, à Trouver et Copier.

Et cette fonction doit: (un peu d'algorithme pourrait clarifier les actions)

1- Trouver les feuilles dont le nom commence par DEBUT_DES_FEUILLES;

2- Trouver la COLONNE_A_COPIER dans chacune de ces feuilles;

3- Copier les cellules non-vide de cette colonne;

4- Trouver la même COLONNE_A_COPIER dans FEUILLE_DESTINATION;

5- Se positionner sur la dernière ligne de la colonne dans la FEUILLE_DESTINATION ;

6 - Y coller les données déjà copier (On n'efface plus les données déjà présentent dans la feuille de destination; on ne fait qu'en ajouter à chaque appel de la fonction).

ATTENTION ! : Je répète, La fonction ne rempli qu'une seule colonne à la fois dans le tableau de la FEUILLE_DESTINATION en allant chercher les données de la COLONNE_A_COPIER dans toutes les feuilles dont le nom commence par DEBUT_DES_FEUILLES. De plus, il est important de souligner que la colonne de destination et celle où l'on va chercher les données ont le même nom ( c-à-d égale au paramètre COLONNE_A_COPIER )

Un exemple: Ainsi, pour remplir convenablement toutes les colonnes du tableau de la feuille "TOUTE CLASSE ACTUELLE" ( du fichier joint) , on doit lancer la fonction à partir d'une autre procédure comme ceci:

Sub main()
' Cette procedure utilise la fonction COPIE_COL_TO_COL pour remplir le tableau de la feuille "TOUTE CLASSE ACTUELLE"

    Dim ListeDesColonnes()
    Dim FeuilleDestination As Worksheet
    Dim DebutDesFeuilles As String
    Dim ColonneAcopier As Variant
    Dim LaColonne As String

    Set FeuilleDestination = ThisWorkbook.Worksheets("TOUTE CLASSE ACTUELLE") ' la feuille de destination
    ListeDesColonnes = Array("NOM & PRENOMS", "MATRICULE", "NIVEAU") ' la liste des Colonnes à copier
    DebutDesFeuilles = "ListeClasse -*" ' Les feuilles où aller chercher les données

    FeuilleDestination.Select
    For Each ColonneAcopier In ListeDesColonnes ' Pour chaque colonne spécifiée
        LaColonne = ColonneAcopier
        COPY_COL_TO_COL FeuilleDestination, DebutDesFeuilles, LaColonne ' on copie et colle la colonne dans le tablleau destination
    Next ColonneAcopier ' on passe à la colonne suivante
    Range(ListeDesColonnes(1)).Cells(1, 1).Select ' selection de la 1ère cellule traitée
End Sub

J'espère avoir bien expliqué le rôle de la nouvelle fonction COPIER_COL_TO_COL(...).

Hourah ! Eureka ! Ça marche Dhany ! Nous avons réussi à le faire fonctionner !

Dhany, tu es génial !

Je me suis replongé dans le code en partant des innovations que tu as apporté à mon fichier de départ et suivant l'algorithme que j'ai décris précédemment, j'ai réécris le code de la procédure. Et voilà ! le résultat est appréciable dans le fichier joint à ce post.

Merci à toi Dhany pour ton aide sans laquelle j'aurai sérieusement bavé

J'imagine que le code pourrait être amélioré, optimisé voir totalement réécrit ... Je t'en prie même


PS: Je viens de me rendre compte d'une petite erreur d'appréciation cachée dans le code.

En fait, la fonction parcourt chacune des colonnes du haut vers le bas à la recherche de la première cellule vide (voir l'instruction)

...
While .Cells(DEBUT_PLAGE_DESTINATION + nbCellulesNonVides, PLAGE_DESTINATION.Column).Value <> ""
    nbCellulesNonVides = nbCellulesNonVides + 1
Wend
...
...
While .Cells(DEBUT_PLAGE_ACOPIER + nbCellulesCopiees, COLONNE_PLAGE_ACOPIER).Value <> ""
     nbCellulesCopiees = nbCellulesCopiees + 1
Wend

Et, Aussitôt qu'elle en trouve une, elle arrête de chercher plus bas et considère comme plage à copier l'ensemble des cellules ainsi parcourues. Fastoche ! Mais, ce n'est pas très intelligent ça ... Cependant, un parcours illimité plomberait totalement les performances

Aurais-tu une idée de comment résoudre cet comportement ?

Bonjour zot,

je te réponds avec beaucoup de retard car j'ai été débordé !

je te propose cette nouvelle version du fichier :

Ctrl r ou clic sur ton bouton « Remplir Tableau » (au choix) ➯ travail effectué

(même si les colonnes des feuilles "ListeClasse -*" sont dans le désordre )

Ctrl e ➯ effacer

tu connais le chemin pour aller voir mon code VBA.

(j'ai choisi la 3ème option de tout réécrire )

à te lire pour avoir ton avis.

dhany

Wow ! J'suis bluffé là ...

Ça marche nickel ton truc ! et le code est si slim que j'en suis tout

Cependant, j'ai quelques remarques:

1- Tu n'as pas tenu compte de toutes mes préoccupations dans le précédent post ;

2- Tu ne prends pas en compte l'idée de pouvoirs paramétrer la procédure;

Du coup, tes obligé d'inscrire en dur la position des 1ères lignes où copier/coller les données.

Ce serait bien que tu puisses revoir cela;

3- Ta procédure rempli en un seul appel, toutes les colonnes de la feuilles destination. alors qu'elle devrait n'en remplir une seule à la fois (pas toutes ). Car vois-tu, si j'ajoute une colonne à l'un des tableaux dans les autres feuilles, c'est sûr que la fonction ferait n'importe quoi ...

J'ai rajouter une 4ème colonne à certains tableaux et ....Bah le bordel recommence (voir fichier joint)

Si tu veux bien t'inspirer du VBA de mon fichier, tu pourrais en faire une merveille... c'est certains

Ya du chemin ...surement

j'avais pas tenu compte de tes remarques car même en regardant ton code VBA, j'avais pas vu où tu indiquais la colonne ! y'a bien la variable LaColonne, mais elle utilise la variable de boucle ColonneAcopier avec LaColonne = ColonneAcopier et cette boucle For fait son job pour toutes les colonnes ! je mets ici la partie de ton code VBA concernée :

For Each ColonneAcopier In ListeDesColonnes ' Pour chaque colonne spécifiée
  LaColonne = ColonneAcopier
  COPY_COL_TO_COL FeuilleDestination, DebutDesFeuilles, LaColonne ' on copie et colle la colonne dans le tablleau destination
Next ColonneAcopier ' on passe à la colonne suivante

laisse-moi du temps pour faire la nouvelle version.

dhany

Super ! Merci

la nouvelle version est prête :

à l'ouverture du fichier, tu es sur la 1ère feuille, et la cellule active est E5 ; fais Ctrl r

va à droite sur F5 ; Ctrl r ; à droite sur G5 ; Ctrl r ; à droite sur H5 ; Ctrl r

un clic sur le bouton « Remplir Colonne » a le même effet que Ctrl r

dans les 2 cas, tu dois sélectionner une cellule de la colonne à remplir avant de lancer la macro !

(ça fera rien sur la colonne N°, mais c'est normal vu qu'elle est pas à remplir)

Ctrl e fait la même chose qu'avant, mais j'ai optimisé le code.

j'te laisse tout vérifier pendant qu'j'fais une longue pause ! A+

dhany

Tu sais quoi dhany, il n'y a rien à redire

Tu viens de gérer d'un coup de baguette magique toutes les préoccupations que je posais.

Tu as tellement bien compris le problème que t'as frappé pile poil dans mille.

L'astuce de remplir les cellules vides intermédiaires par des "-" est propre !

Tout fonctionne parfaitement maintenant et j'en suis et sincèrement

Et ça, tu mérite des .

Je te mets carrément un bien mérité.

Franchement merci infiniment pour le coup de main de

merci pour ton retour, pour la note et pour le !

dhany

Rechercher des sujets similaires à "creer fonction copie colonne meme nom"