Macro copie/colle des cellules contigues d'un classeur dans autre classeur

Bonjour à tous

J'ai un classeur A qui me sert à générer une fiche densité de semis pour un agriculteur et pour une variété. Les données renseignés dans cette fiche se retrouvent ensuite dans des cellules contigues (ex : A3:H3 / AA3 / AC3 / etc ...) de la ligne n°3 sur une feuille SB1 et une autre feuille SB2 du classeur A qui ont quasi la même structure.

J'aimerai créer une macro qui copie ces cellules contigues de la ligne n°3 de SB1 et SB2 du classeur A vers la ligne n°3 des feuilles SBA et SBB quasi identique à SB1 et SB2 dans un classeur B.

Une fois que la copie serait effectué, quand je change d'agriculteur et de variété dans le classeur A, les cellules de la ligne n°3 des feuilles SB1 et SB2 ont de nouvelles données qui devront à nouveau être copier mais qui cette fois devront être collé à la ligne n°4 (à la suite donc) des feuilles SBA et SBB du classeur B. Et ainsi de suite à chaque fois que je change d'agriculteur et de variété, copie ligne 3 du classeur A vers ligne 5 du classeur B, changement d'agri + variété, copie ligne 3 du classeur A vers ligne 6 du classeur B, etc etc...

Pouvez vous m'aider à établir cette macro ? Je débute en VBA et je galère un peu avec le code. Merci aux âmes charitable :)

Bonjour,

Voici un premier essai avec le code ci-dessous (à insérer dans un module normal du classeur A) :

Sub Archiver()
set wbdest = workbooks.open("ClasseurB")
tShSource = array("SB1", "SB2")
tShDest = array("SBA", "SBB")
RefSource$ = "A3:H3, AA3, AC3"
for i = lbound(tShSource) to ubound(tShSource)
    t = StockerValeurs(tShSource(i), RefSource)
    RestituerValeurs t, wbdest, tShDest(i), RefSource
next i
wbdest.close true
end sub

Function StockerValeurs(NomFeuille$, RefPlage$)
with thisworkbook.sheets(NomFeuille) '<<< Classeur A (source)
    for each cell in .range(RefPlage)
        n = n + 1: redim preserve t(1 to n)
        t(n) = cell.value
    next cell
end with
StockerValeurs = t
end sub

Sub RestituerValeurs(Tableau, Classeur as workbook, NomFeuille$, RefPlage$)
with Classeur.sheets(NomFeuille)
    nvl = .cells(.rows.count, 1).end(xlup).row + 1
    for each cell in .range(replace(RefPlage, "3", "" & nvl))
        n = n + 1
        cell.value = Tableau(n)
    next cell
end with
end sub

Le classeur B doit être fermé avant l'exécution. La mcro copie toujours la ligne 3 de chaque feuille vers la plage correspondante mais à la première ligne vide.

L'essentiel du code dépend de paramètres. Il faudra adapter toutes les références (noms de classeur, de feuilles, de plage) afin d'éviter les bugs car il n'y a pas vraiment de contrôles (existence des feuilles, existence classeur, classeur ouvert, ....).

Je pourrai commenter le code si besoin.

Cdlt,

Merci pour ta réponse

J'ai quelques petites précision à apporter :
- les cellules à copier ne sont pas exactement les même pour SB1 et SB2 dans le classeur A :
SB1 : A3:H3 / AA3 / AC3 / AQ3 / AX3 / D3:DF3
SB2 : A3:H3 / AA3 / AC3 / AE3 / AH3:AJ3 / AL3 / AS3 / AZ3 / DG3:DH3

- la destination où les coller dans SBA et SBB seront les même cellules dans le classeur B :
SBB : A3:H3 / AA3 / AC3 / AQ3 / AX3 / D3:DF3
SBB : A3:H3 / AA3 / AC3 / AE3 / AH3:AJ3 / AL3 / AS3 / AZ3 / DG3:DH3

Je suppose donc que la ligne de code RefSource$ devra être modifier en prenant en compte ces précisions ?

2e point, dans la ligne de code Function StockerValeurs(NomFeuille$, RefPlage$) :
- NomFeuille$ : je suppose que je peux écrire à la place SB1$ ? ou puis je mettre SB1$ et SB2$ ?
- RefPlage$ : je ne sais pas par quoi remplacer ce code

3e point, dans la ligne de code Sub RestituerValeurs(Tableau, Classeur as workbook, NomFeuille$, RefPlage$) :
- Classeur : je dois ici le remplacer par ClasseurB (le classeur de destination donc) en rajoutant derrière as workbook ?
- NomFeuille$ : dois je indiquer le nom des 2 feuilles du classeur B ? Du genre SBA$, SBB$ ?
- RefPlage$ : je ne sais pas par quoi remplacer ce code
- Tableau : là non plus

Exactement !

Voici une adaptation du code en tenant de ces nouvelles plages :

Sub Archiver()
set wbdest = workbooks.open("ClasseurB") 'classeur B (destination)
tShSource = array("SB1", "SB2") 'tableau des noms de feuille de la source
tShDest = array("SBA", "SBB") 'tab des noms feuille dest
tRef = array("A3:H3, AA3, AC3, AQ3, AX3, D3:DF3", "A3:H3, AA3, AC3, AE3, AH3:AJ3, AL3, AS3, AZ3, DG3:DH3") 'tableau références plages
for i = lbound(tShSource) to ubound(tShSource) 'pour chaque item de tShSource (mais en réalité de chacun des 3 tableaux ci-avant)
    t = StockerValeurs(tShSource(i), tRef(i)) 't recoit les valeurs contenues dans la plage tRef(i) de la feuille tshsource(i)
    RestituerValeurs t, wbdest, tShDest(i), tRef(i) 'on restitue les valeurs de t dans le classeur wbdest à la feuille tshDest(i) sur la plage tRef(i)
next i
wbdest.close true 'on ferme le classeur
end sub

Function StockerValeurs(NomFeuille$, RefPlage$)
with thisworkbook.sheets(NomFeuille) '<<< Classeur A (source)
    for each cell in .range(RefPlage)
        n = n + 1: redim preserve t(1 to n)
        t(n) = cell.value
    next cell
end with
StockerValeurs = t
end sub

Sub RestituerValeurs(Tableau, Classeur as workbook, NomFeuille$, RefPlage$)
with Classeur.sheets(NomFeuille)
    nvl = .cells(.rows.count, 1).end(xlup).row + 1
    for each cell in .range(replace(RefPlage, "3", "" & nvl))
        n = n + 1
        cell.value = Tableau(n)
    next cell
end with
end sub

Non, justement, ce sont des macros qui dépendent de paramètres (variables rentrant en arguments). Cela permet de rendre le code plus dynamique. C'est donc dans la macro Archiver qu'on appelle ces macros (parmi elles, il y a une fonction qui renvoie un tableau). Je vais commenter la macro Archiver.

Donc, la boucle permet d'exécuter le code indifféremment :

première itération : on copie la plage de SB1 vers SBA,

seconde itération : on copie la plage de SB2 vers SBB.

Avec les fichiers ça sera peut-être plus facile ^^

Ok merci pour ces précisions. Je testerai demain

Je pense que je ne testerai pas. J'ai plutôt confiance et j'ai l'impression que le code est fonctionnel. Le seul risque serait une incompatibilité de type ou une erreur liée à une mauvaise adaptation des noms d'objets.

Il faut mettre le chemin complet du classeur B dans le code (avec le répertoire et l'extension).

Il faut mettre les noms exacts des feuilles. Pour le reste, je ne vois rien de problématique pour l'instant.

Cdlt,

Hello 3GB

Alors j'ai essayé ta macro mais ça ne marche pas. Il me met la première ligne Sub Archiver() en jaune. Je pense qu'il y a encore des choses que je dois modifier mais que je n'ai pas saisi.

La partie Archiver semble bien rempli, c'est avec la suite que j'ai des problèmes :

Function StockerValeurs(NomFeuille$, RefPlage$) 'on est d'accord que je laisse ça tel quel ?
with thisworkbook.sheets(NomFeuille) '<<< Classeur A (source) >>>> pareil, je laisse tel quel la ligne de code ?
    for each cell in .range(RefPlage) 'là aussi ?
        n = n + 1: redim preserve t(1 to n)
        t(n) = cell.value
    next cell
end with
StockerValeurs = t
end sub

Sub RestituerValeurs(Tableau, Classeur as workbook, NomFeuille$, RefPlage$) 'et là aussi je met la ligne tel quel ?
with Classeur.sheets(NomFeuille)
    nvl = .cells(.rows.count, 1).end(xlup).row + 1
    for each cell in .range(replace(RefPlage, "3", "" & nvl))
        n = n + 1
        cell.value = Tableau(n)
    next cell
end with
end sub

Dans la partie Archiver, voici l'erreur indiqué :

Salut Lambda,

Oui, comme expliqué hier, c'est normal, ce sont des variables déterminantes dans l'exécution de la macro, ce sont des paramètres.

Ces macros paramétrées s'exécutent donc indifféremment (elles sont plus dynamiques) et produisent un résultat changeant en fonction des valeurs renseignées en argument.

Voici un nouvel essai :

Sub Archiver()
dim wbdest as workbook, tShSource, tShDest, tRef, t
set wbdest = workbooks.open("ClasseurB") 'classeur B (destination)
tShSource = array("SB1", "SB2") 'tableau des noms de feuille de la source
tShDest = array("SBA", "SBB") 'tab des noms feuille dest
tRef = array("A3:H3, AA3, AC3, AQ3, AX3, D3:DF3", "A3:H3, AA3, AC3, AE3, AH3:AJ3, AL3, AS3, AZ3, DG3:DH3") 'tableau références plages
for i = lbound(tShSource) to ubound(tShSource) 'pour chaque item de tShSource (mais en réalité de chacun des 3 tableaux ci-avant)
    t = StockerValeurs(tShSource(i), tRef(i)) 't recoit les valeurs contenues dans la plage tRef(i) de la feuille tshsource(i)
    RestituerValeurs t, wbdest, tShDest(i), tRef(i) 'on restitue les valeurs de t dans le classeur wbdest à la feuille tshDest(i) sur la plage tRef(i)
next i
wbdest.close true 'on ferme le classeur
end sub

Function StockerValeurs(NomFeuille, RefPlage)
dim t()
with thisworkbook.sheets(NomFeuille) '<<< Classeur A (source)
    for each cell in .range(RefPlage)
        n = n + 1: redim preserve t(1 to n)
        t(n) = cell.value
    next cell
end with
StockerValeurs = t
end function

Sub RestituerValeurs(Tableau, Classeur as workbook, NomFeuille, RefPlage)
with Classeur.sheets(NomFeuille)
    nvl = .cells(.rows.count, 1).end(xlup).row + 1
    for each cell in .range(replace(RefPlage, "3", nvl))
        n = n + 1
        cell.value = Tableau(n)
    next cell
end with
end sub

Cdlt,

Ok merci, je viens de comprendre.

Du coup j'ai effectué les modif et maintenant l'erreur serait la suivante :

Il faut rajouter dim t() dans la fonction (à la première ligne, juste avant le with)

Ca ne marche pas

J'ai essayé de l'écrire sur la même ligne Dim t() With ThisWorkbook etc ... mais toute la ligne se met en rouge

J'ai remplacé End Sub par End Function et le copie colle semble marcher quand je clique sur le bouton ou la macro est affecté :)

Par contre quand je reclique sur le bouton, le collage se fait toujours sur la ligne n°3 et non à la suivante. Une idée ?

Le collage se fait toujours sur la ligne 3 ? Mais est-ce que tu as effacé les données de la ligne 3 de destination avant de relancer la macro ?

Ok je crois avoir résolu le problème, le copie colle se fait à la suite. Merci encore pour tout Gringo :)

Oui, j'ai cru comprendre qu'il fallait que les données soient différentes sur la ligne n°3 pour que le collage se fasse à la suite dans le classeur de destination.

Ca semble marcher nickel. Encore 1000 fois merci

Gringo ?

Super !

Non, non, les données sont collées à la première ligne dont la valeur en colonne A est vide (en remontant du bas de la feuille). Si ça n'a pas marché la première fois, c'est parce que tu as effacé les données, quitté sans sauvegarder (si exécution au pas à pas par exemple) ou déplacer les données (celles en colonne A tout du moins).

Si tu souhaites rajouter des feuilles, c'est tout à fait possible : il suffit de rajouter un item à chaque array de la macro Archiver :

tshSource = array("SB1", "SB2", "SB3")

tshdest = array("A", "B", "C")

tref = array("...", "...", "A3:....")

par exemple.

Si jamais tu prévoies de coller des plages qui ne commencent pas en colonne A, je recommande de modifier cette ligne ainsi (dans Restituer) :

nvl = .usedrange.rows.count + .usedrange.row

Cdlt,

Par contre j'ai une dernière requête, je souhaiterai éviter que la macro me ferme le fichier une fois son execution finie. Dois je enlever entièrement la ligne de code

wbdest.Close True

?

Dans le même ordre d'idée, comme le ClasseurB de destination reste ouvert, j'aimerai que la 2e fois que je clique sur le bouton que la macro n'ai pas besoin de rouvrir le classeurB et ainsi éviter un potentiel bug. Une idée de la ligne de code à intégrer ?