Formule pour collage répétif

[fabrice]

bonsoir le forum

Je souhaiterai connaitre une méthode qui me permettrait de copier des cellules automatiquement, suivant une phase donnée.
Je m'explique:
Je dispose de 24 cellules qui doivent etre recopier en dessous. la permière recopier doit venir apres la 24 cellule (elles sont alignées verticalement). Ce recopiage doit etre fait jusqu'a la fin du tableau.

1
2
3
4
...
24
1
2
3
4
...

Si c'est pas claire, je peux essayer de vous réexpliquer.

Merci de votre réponse,
FAb

 

[Vériland]

Bonsoir Fabrice,

Si c'est pour coller par exemple les cellules A1:A24, toujours à la suite de la dernière cellule pleine de la liste, cette macro fera l'affaire...

Sub CopierColler()
Range("A1:A24").Select
Selection.Copy
Columns(1).Find("*", , , , , xlPrevious).Offset(1, 0).Select
ActiveSheet.Paste
Application.CutCopyMode = False
End Sub

A essayer si cela te convient...

A+ Vériland

 

[@+Thierry]

Bonsoir Fabrice et Vériland,

Vu que Fabrice voulait un recopiage jusqu'à la fin du tableau... J'ai préparé un truc qui va copier les 24 cellules immédiatement adjacente en lignes inférieures depuis n'importe quelle cellule que le user doit indiquer dans une inputbox...

La macro va calculer pour recopier indéfiniement jusquà la fin de tableau par tranche de 24... autant de fois que celà est possible dans la limite Max...
Fabrice n'ayant pas précisé de quel tableau il s'agissait ... J'ai pris la feuille entière comme tableau !! (çà dure un moment !! (lol)

Enfin c'est juste un exercice car j'avais jamais eu besoin de faire çà !! (lol) mais disons que c'est plus élaboré que la macro de Vériland, mais je pense que çà ne sert à rien !!

Sub Copie24X()
depart = InputBox("Entrez la cellule de départ svp", "ADRESSE DE LA 1er CELLULE", A1)
Range(depart).Select
Ligne = Selection.Row
Col = Selection.Column
X = (65536 - Ligne - 24) / 24
'Max = RoundDown(X, 0) NE MARCHE PAS faut faire comme çà :
Max = Application.WorksheetFunction.RoundDown(X, 0)
Range(Selection, Selection.Offset(23, 0)).Select
Selection.Copy
For Collage = 1 To Max
Cells(Ligne, Col).Select
Selection.Offset(24, 0).Select
ActiveSheet.Paste
Ligne = Ligne + 24
Next Collage
MsgBox "Vos 24 lignes ont été copiées " & Max & " de Fois !"
Range(depart).Select
Application.CutCopyMode = False
End Sub


Just for the fun !!

ASTUCE : Interressant le "Application.WorksheetFunction" pour intégrer des fonctions qui ne sont pas directement comprises en VBA !! (Round c'est OK, mais pas RoundDown, donc faut faire comme çà !!)

Bonne Nuit
@+Thierry

 

[fabrice]

Mercy super thierry

Juste une petitie question encore, dans ta macro, la fin du tableau est vers la ligne 65536. est ce que c'est possible de trouver la fin du tableau est de faire terminer la macro à la dermiere cellule de la colnne de reférence (colonne A).

Merci encore a vous deux
FAb

 

[@+Thierry]

Bonjour Fabrice, Bonjour à tous et toutes,

Ben... Je suppose que ton tableau est vide à l'origine ? puisque tu veux des copies dedans... Donc pour que VBA trouve la fin du tableau il faut une balise !!! (même si elle se trouve dans une autre colonne...) à préciser ???

Si tout est vide il peut s'agir d'une cellule avec un format... Quoique dans ce cas on sait déjà la plage à couvrir... (dans ce cas la Valeur de Max peut être initialisée directement, exemple ton tableau fini en Ligne 500, il suffit de :
- Changer => X = (65536 - Ligne - 24) / 24 |PAR|=> X = (500 - Ligne - 24) / 24
Pour s'arréter pile (pour compléter les dernières cellules n'étant qu'une fraction en dessous de 24) il faudrait une nouvelle variable style "Dif"
Voici une nouvelle version (vite faite pendant mon café !)

Sub Copie24XNet()
depart = InputBox("Entrez la cellule de départ svp", "ADRESSE DE LA 1er CELLULE", A1)
Range(depart).Select
Ligne = Selection.Row
Col = Selection.Column
Table = 500
X = (Table - Ligne - 24) / 24
Max = Application.WorksheetFunction.RoundDown(X, 0)
Dif = Table - 24 - (Max * 24)
Range(Selection, Selection.Offset(23, 0)).Select
Selection.Copy
For Collage = 1 To Max
Cells(Ligne, Col).Select
Selection.Offset(24, 0).Select
ActiveSheet.Paste
Ligne = Ligne + 24
Next Collage
Cells(Ligne, Col).Select
Range(Selection, Selection.Offset(Dif - 1, 0)).Select
Selection.Copy
Selection.Offset(24, 0).Select
ActiveSheet.Paste
MsgBox "Vos 24 lignes ont été copiées " & Max & " de Fois ! Plus " & Dif & " lignes..."
Range(depart).Select
Application.CutCopyMode = False
End Sub

Pour que cette macro ne tourne qu'en colonne A il suffit de :
- Virer => Col = Selection.Column
- Changer => Cells(Ligne, Col).Select |PAR|=> Cells(Ligne, 1).Select

Voilà Fabrice, ce devrait être plus "propre"
Bonne Journée
@+Thierry

 

[fabrice]

Merci pour ta macro et tache de ne pas te bruler avec ton café!

Juste un petit détail. Est ce qu la macro peut détecter la derniere ceulle de la colonne de reference et etre éxécuter jusque la???
Si c'est possible, la colonne de reférence est la colonne a.

Juste un autre point de détail, quant on execute la macro, elle ne copie que les 23 preimer lignes et la 24eme est vide. Sinon tout marche bien.

Merci beaucoup
FAb

 

[fabrice]

C'est encore moi,

Juste, le dernier détail n'est pas a prendre en compte, g fais une fausse manip !!!

FAb

 

[@+Thierry]

Re Fabrice,

Il semble qu'on ne soit pas sur la même longueur d'onde , enfin en tout cas la même dernière cellule (lol)

Comme j'ai expliqué pendant mon café mais ce ne devait pas être sufisamment clair... La macro doit détecter quelque chose qui lui permet d'identifier la dernière cellule... Pour celà TROIS moyens différents en, fonction de trois possibilités :

1) Ta colonne A contient déjà des cellules remplies... Et tu veux que la série copiée "écrase" toutes ces cellules déjà remplie...

2) Ta colonne A ne contient que 24 cellules remplies et toutes les autres sont vides, par contre la colonne B contient des valeurs jusqu'à une certaine ligne... qui va servir de référence comme limite du copiage...

3) Soit tu connais d'avance la dernière ligne de ton tableau... (celà peut être un formatage de cellule etc)

VBA ne pourra pas trouver la dernière ligne autrement... Il lui faut les "dimensions" de la zone à couvrir, comprends-tu...

Donc "Est ce que la macro peut détecter la derniere cellule de la colonne de reference et etre éxécuter jusque là???" OUI, mais en fonction de ta réponse sur l'une des trois possibilités...

Pour finir je suppose que le point "elle ne copie que les 23 premieres lignes et la 24eme est vide"... est celui annulé par ton post suivant... Car ce code copie 24 cellules quoi qu'il arrive!!!... Bien sur si une des cellules d'origine est vide, la copie de celle ci sera reportée vide !! (si tu veux on peut faire écrire "Vide" pour les cellule vides !! (lol)

Bonne Journée
@+Thierry

 

[fabrice]

merci de ta réponse.

Il s'agit de la solution 2. Par contre les cellules sont remplies sur la colonne A, donc servent de limite et les 24 à copier sont sur la colonne B.

Merci de ta réponse.
FAb

 

[@+Thierry]

Bonsoir Fabrice,

Je relis ce dernier post où tu dis carrément après déjà deux fois que je te prépare des code... que maintenant on travaille sur 2 colonnes... alors qu'au début :
"Je dispose de 24 cellules qui doivent etre recopier en dessous. la permière recopier doit venir apres la 24 cellule (elles sont alignées verticalement)"

Bon écoute, je ne vais pas y passée la nuit !! ni mon week end
Essaie de voir si çà te va... et essaie d'arranger à ta convenance...

Tu as deux boite de dial, une pour la cellule de départ et une pour la cellule d'arrivée...

Sub Copie24XNet()
depart = InputBox("Entrez la cellule de départ svp", "ADRESSE DE LA 1er CELLULE", A1)
Range(depart).Select
LigneD = Selection.Row

Limit = Sheets("Feuil1").Range("A65536").End(xlUp).Row

Range(Selection, Selection.Offset(23, 0)).Select
Selection.Copy

Arrive = InputBox("Entrez la cellule d'arrivée svp", "ADRESSE DE LA 1er CELLULE", B1)
Range(Arrive).Select
LigneA = Selection.Row
ColA = Selection.Column
DifA = LigneA
X = (Limit - LigneD) / 24
Max = Application.WorksheetFunction.RoundDown(X, 0)
Dif = Limit - (Max * 24)

For Collage = 1 To Max
Cells(LigneA, ColA).Select
ActiveSheet.Paste
LigneA = LigneA + 24
Next Collage
Cells(1, 1).Select
Range(Selection, Selection.Offset(Dif - DifA, ColD)).Select
Selection.Copy
Cells(LigneA, ColA).Select
ActiveSheet.Paste
Range(Arrive).Select
Application.CutCopyMode = False
End Sub

Bye
@+Thierry

 

[Vériland]

Houlà, not' Thierry va devenir tout rouge là...Hé! les gars...faut pas jouer comme ça avec les "macros"...sinon il va finir "accros"...on a encore besoin de lui a ce "propos"...tiens v'la que j'fais des rimes maintenant...

là faut r'connaitre que c'est quand même explicite depuis l'début...zzz...zzz...dans les réponses...

Bonne nuit Thierry et le forum

 

[fabrice]

merci de ta réponse.

Je sais que pour toi c'est pas facil de nous aider si c'est pas précis mais d"un autre coté, bien expliquer est aussi tres difficile. (c a s e travaille!!!)
Je feraimieux le prohaine fois.

Merci encore

FAb

 

[fabrice]

salut thierry

Je viens d'essayer la macro.
Il y a un petit probleme.
Je ne sais pas si je l'utilise bien. Voila comment je procede.
Les cellules à copier sont de B6 à B29.
Lors du premier message, je rentre la cellule B6 et lors du second, B30.
Les cellules se copient jusqu'a la ligne 101 dans la colonne B.
Les données de la colonne A s'arretent à la ligne 83.

J'ai un message qui apparait et il me dit qu'il y a "une erreur d'execution 1004" et le programme surligne la ligne suivante:
"Range(Selection, Selection.Offset(Dif - DifA, ColD)).Select"

D'apres toi, ca viens de quoi??? Est ce que la macro détecte la derniere cellule de la colonne A comme limite???

Merci de ta réponse (si ca ne te dérange pas).
FAb

 

[@+Thierry]

Bonjour Fabrice,

C'est normal, cette macro est faite pour copier 24 cellules de la colonne "A" pour les reporter sur une colonne "B".... Comme j'ai compris dans ton post du 06-12-02 23:00...
En fait A et B peuvent être spécifiés dans les deux InputBox Départ et Arrivée....

C'est sûr que çà ne va pas marcher si tu fais tourner de B à B !

Bon là je me réveille et je bois mon café... J'y reviendrais plus tard... Mais si tu es pressé, tu as ce qui faut en t'inspirant des deux dernières macros...

Tu prends le code du 06-12-02 08:16
et tu changes :
Table = 500 |PAR|=> Table = Sheets("Feuil1").Range("A65536").End(xlUp).Row

Ce devrait être déjà plus proche de ce que tu veux obtenir... Tu fais çà et tu me fais le topo des erreurs et des trucs que tu n'as pas encore spécifiés...

Bon courage Fab, car il en faut avec toi !!

Bon Dimanche
@+Thierry

 

[fabrice]

Resalut

Je sais qu'il en faut du courage avec moi!!!!

Ne t'énerve pas mais je ne sais pas si on s'est bien compris.
Je dispose dans la colonne A des cellules qui doivent servir de limite (ex A250 est la derniere cellule de la colonne).
Dans la colonne B, les 23 premeires cellules sont les cellules de référence à recopier.

Le recopiage doit commencer en dessous de la 23 cellule recopiée de la colonne B.

Merci
FAb