Copie multiple d'une cellule

Bonjour,

Je dois copier le contenu d'une cellule (A1) dans une plage de cellule connue (A1:C600) avec un pas de 62 lignes dans les colonnes A et C.
Je pense que je dois réaliser une boucle, mais je ne sais pas vraiment sur quoi partir. J'ai déjà fait pas mal de chose en VBA, mais je ne me suis jamais frotté à cette fonction.

Pourriez-vous me donner un exemple que j'essaierai d'adapté à ma situation.

Merci par avance.

Slt Forum, demongin,

Inspire-toi de ceci..

Code:

---

1 2 3 4 5 6 7 8 9

Private Sub CommandButton1_Click()   Dim i As Integer   For i = 1 To 600 Step 62 Cells(i, 1).Value = Cells(1, 1).Value Next i   End Sub

---

Bonne soirée !

Merci,

Est-il possible d'utiliser cela dans un module avec une macro de type Sub et non Private Sub, car je ne souhaite pas déclencher cette action par un bouton, mais l'inclure avec un autre processus ?

Autre petite question : ma cellule est en fait une fusion de plusieurs cellules et la destination est de taille identique ; est-ce un problème ? la référence à prendre en compte est seulement la cellule de la première ligne et la première colonne ou il faut modifier la macro pour prendre en compte une plage de cellule ?

J'ai écrie ce bout de code et il me pose un gros soucis.
Il copie bien ce que je demande à l'endroit voulu, mais Excel reste figé pendant 2 minutes environs sans qu'il soit possible de faire quoi que se soit, puis l'écran clignote comme si il y avait des centaines d'occurrences traitées, avant de retrouver la main et de voir le résultat.

Code:

---

1 2 3 4 5 6 7 8 9

Sub EnTete() Dim x As Integer For x = 1587 To 1761 Step 62 Cells(1587, 97).Copy Cells(x, 97).PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False Next x   End Sub

---

Si vous pouviez m'aider, se serait cool, d'autant que je faire cela avec une plage de cellule et non une seule cellule et je ne vois pas bien comment mettre cela en forme.
:arf:

Hello,

pour enlever l'effet sur l'écran, tu peux faire comme ceci..

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14

Sub EnTete() Dim x As Integer   Application.ScreenUpdating = False   For x = 1587 To 1761 Step 62 Cells(1587, 97).Copy Cells(x, 97).PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False Next x   Application.ScreenUpdating = True   End Sub

---

Merci,

Je connaissais cette commande, mais je pense que le problème venait d'ailleurs. En effet, j'ai avancé d'un pas (62 lignes) et plus aucun problème ; c'est quasi instantané.

Code:

---

1 2 3 4 5 6 7 8 9

Sub EnTete() Dim x As Integer For x = 1649 To 1761 Step 62 Cells(1587, 97).Copy Cells(x, 97).PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False Next x   End Sub

---

Par contre, je bloque toujours pour adapter ce code à des cellules fusionnées.
Tous ce que j'ai testé est un échec pour le moment...
En attendant une âme charitable, je repart en quête car je dois avoir fini avant 16h30. :roll:

Re,

Personnellement, je n'aime pas trop les cellules fusionnées..

Ce que tu peux essayer, c'est de tester avec l'enregistreur de macro, de fusionner deux cellules (ou plus) et de voir la syntaxe... Peut-être que ça t'aidera.

Bonne journée !

En fait les cellules sont déjà fusionnées et bien sûr les plages que je veux copier sont identiques. J'en suis là au niveau du code et j'ai une erreur 1004 "la méthode 'Range' de l'objet '_Global' a échoué"

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16

Sub EnTete()   Dim x As Integer Dim yy As Range Dim zz As Range   For x = 1649 To 1761 Step 62 u = x + 2 Set yy = Range("A" & x) Set zz = Range("AV" & u) Range("A1587:AV1589").Copy Range("yy:zz").PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False Next x   End Sub

---

Bonjour

en cas de cellules fusionnées seule la cellule la plus en haut à gauche est prise en compte donc

si A1-A5 fusionné et C1-C5 fusionné

Code:

---

RAnge("A2") ="test"

---

la cellule fusionné A1 sera vide

Code:

---

RAnge("A1") ="test"

---

la cellule fusionné A1 sera égal à "Test"

Code:

---

RAnge("C2") = RAnge("A1")

---

la cellule fusionné C1 sera vide

Code:

---

RAnge("C1") = RAnge("A1")

---

la cellule fusionné C1 sera égal à la cellule fusionné A1

et cela, peut importe le nombre de cellule fusionnées

en espérant que ça t'éclaire un peu

re bonjour

je viens de voir ton code aprè avoir répondu,

déja il y a un erreur ici
remplace

Code:

---

Range("yy:zz").PasteSpecial

---

par

Code:

---

Range(yy.Address & ":" & zz.Address).PasteSpecial

---

ça devrait aller mieux

Merci Zyhack,

Je connais cette propriété des cellules fusionnées, mais cela ne règle pas mon problème.
Je vais aller un peu plus loin dans le détail :
- Ma feuille comporte un certain nombre de tableau,
- Chaque tableau correspond à un format A4,
- Chacun avec une entête formé d'une plage de cellules fusionnées,
- Toutes les plages sont de forme et taille identique,
- L'idée consiste à ce que l'utilisateur ne saisisse qu'une fois le contenu de l'entête avec sa propre mise en forme (police, couleur, etc..) sans les bordures,

Si j'essaye de faire cette copie en ciblant la première cellule à gauche de la plage vers la même de la plage suivante, il me copie le contenu dans toutes les cellules de la plage et ce n'est pas le résultat souhaité.

Voilà mon problème du moment, d'où la tentative avec Range et non Cells

Citation:

---

Envoyé par zyhack

re bonjour

je viens de voir ton code aprè avoir répondu,

déja il y a un erreur ici
remplace

Code:

---

Range("yy:zz").PasteSpecial

---

par

Code:

---

Range(yy.Address & ":" & zz.Address).PasteSpecial

---

ça devrait aller mieux

---

Mille fois merci, çaaaa marchhheeee ! :ccool:
(désolé, nos derniers posts se sont croisés)

Le code final :

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16

Sub EnTete()   Dim x As Integer Dim yy As Range Dim zz As Range   For x = 1649 To 1761 Step 62 u = x + 2 Set yy = Range("A" & x) Set zz = Range("AV" & u) Range("A1587:AV1589").Copy Range(yy.Address & ":" & zz.Address).PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False Next x   End Sub

---