[VBA]Boucle : copier 2 fois une cellule et recommencer jusqu'à la fin de la colo [Résolu]

Messages postés
11
Date d'inscription
vendredi 6 juillet 2007
Statut
Membre
Dernière intervention
16 avril 2012
- - Dernière réponse : broglienew
Messages postés
11
Date d'inscription
vendredi 6 juillet 2007
Statut
Membre
Dernière intervention
16 avril 2012
- 16 avril 2012 à 22:43
Bonsoir
Je butte sur une bétise de boucle.
Voila je chercher à copier 2 fois la première cellule A1 FRED dans A2 et A3 puis 2 fois la 4 ème cellule A4 PAUL dans A5 et A6 et comme cela jusqu'à la fin de la colonne.
A1 FRED
A2
A3
A4 PAUL
A5
A6
A7 JEAN
A8
A9

j'ai commencer un code mais cela ne fonctionne pas.Pouvez vous m'aider please!!


Sub copier_cellules()
Range("F2").Select ' sélectionne e champ
Do While ActiveCell <> ""
Selection.Copy
Selection.Offset(1, 0).Select ' Curseur en dessous
ActiveSheet.Paste
Selection.Copy
Selection.Offset(1, 0).Select ' Curseur en dessous
ActiveSheet.Paste
Loop
End Sub

Merci
Afficher la suite 

4 réponses

Meilleure réponse
Messages postés
18039
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
209
3
Merci
Bonjour,
que faut ta discussion dans le thème Forum > Visual Basic 6 > Diversalors que selon toute apparence tu développes sous VBA/Excel ?
Tu aurais du l'ouvrir dans le thème (note-le bien pour les fois suivantes) : Langages dérivés > VBA

On ne travaille pas à coups de Select > coy > paste ! (évite ce genre de procédé).

Regarde ce que fait ceci, tout bêtement (avec ton exemple ) :

Dim derlig As Long, i As Long, j As Integer
With Sheets("Feuil1")
  derlig = .Range("A" & Rows.Count).End(xlUp).Row
  For i = 1 To derlig Step 3
    For j = 1 To 2
      .Range("A" & i + j).Value = .Range("A" & i)
    Next
  Next
End With

Ni select, ni copy, ni paste !

________________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement vous dire ce qu'elle contient. Je n'interviendrai qu'en cas de nécessité de développ

Dire « Merci » 3

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

Codes Sources 133 internautes nous ont dit merci ce mois-ci

Commenter la réponse de ucfoutu
Messages postés
18039
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
209
0
Merci
Tiens (toujours sans ces select, copy, paste) ===>>
En voilà une autre, juste pour t'ouvrir des horizons. Elle est plus "rigolote"
Dim toto As Range, titi As Range, derlig As Long
With Sheets("Feuil1")
  derlig = .Range("A" & Rows.Count).End(xlUp).Row
  On Error Resume Next ' (pour le cas où tout serait déjà rempli)
  Set toto = .Range("A1:A" & derlig + 2).SpecialCells(xlCellTypeBlanks)
  If Not toto Is Nothing Then
    For Each titi In toto
      titi.Value = titi.Offset(-1, 0).Value
    Next
  End If
End With


Tu vois ?
On pourrait en faire d'autres encore

________________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement vous dire ce qu'elle contient. Je n'interviendrai qu'en cas de nécessité de développ
Commenter la réponse de ucfoutu
Messages postés
18039
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
209
0
Merci
Tiens en voilà encore une.
Celle-ci (comme d'ailleurs la précédente), remplira les blancs avec ce qui se trouve au-dessus (quel que soit le nombre de blancs) :
Dim i As Long, derlig As Long
With Sheets("Feuil1")
  derlig = .Range("A" & Rows.Count).End(xlUp).Row
  For i = 1 To derlig
       If .Range("A" & i).Value "" Then .Range("A" & i).Value  .Range("A" & i).Offset(-1, 0).Value
  Next
End With

Cette méthode pourra te paraître plus simple (en ce qui concerne le code). Elle est toutefois légèrement plus lente que les deux premières).

Si, par ailleurs, le nombre de lignes à traiter est très important, dis-le et on passera à une méthode encore autre hyper-rapide (utilisation d'un tableau dynamique).



________________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement vous dire ce qu'elle contient. Je n'interviendrai qu'en cas de nécessité de développ
Commenter la réponse de ucfoutu
Messages postés
11
Date d'inscription
vendredi 6 juillet 2007
Statut
Membre
Dernière intervention
16 avril 2012
0
Merci
Merci beaucoup !!
Je ne te fais pas la bise mais le coeur y est.
Slt
Commenter la réponse de broglienew