Boucle infinie pour copier coller sur vba

Résolu
legalize83 Messages postés 7 Date d'inscription jeudi 4 juin 2009 Statut Membre Dernière intervention 10 juin 2009 - 4 juin 2009 à 12:32
legalize83 Messages postés 7 Date d'inscription jeudi 4 juin 2009 Statut Membre Dernière intervention 10 juin 2009 - 6 juin 2009 à 21:51
Bonjour
.
Je souhaiterais pouvoir copier une plage de cellules qui peut être variable selon le nombre de cellules saisie vers une autre plage de cellule sur une autre feuille.
J'aimerais en plus pouvoir copier ces cellules plusieurs fois et les coller à chaque fois en dessous de la plage de cellules ou les données ont été coller lors de la première opération.
Pour cela, j'ai essayé ceci:
Sub enregistrement2 ()
Dim I As Range
    Set I = ThisWorkbook.Worksheets("COMMANDE CLIENT").Range("D6:D26")
    Dim j As Range
    Set j = ThisWorkbook.Worksheets("données commandes").Range("F3:F1000")
    If Not IsEmpty(I) Then
    I.Select
    Selection.Copy
    Range(j).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Else
    Do
    While Not IsEmpty(j)
    j.Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Wend
    Loop
End sub

J'attends une réponse au plus vite merci d'avance.

9 réponses

cnt Messages postés 219 Date d'inscription lundi 21 novembre 2005 Statut Membre Dernière intervention 20 décembre 2010 1
6 juin 2009 à 19:43
salut
Si j'ai bien compris, voila une solution

Sub Enregistrement2()
    Dim I As Range
    Set I = ThisWorkbook.Worksheets("commande client").Range("D6:D26")
    Dim J As Range
    Set J = ThisWorkbook.Worksheets("données commandes").Range("F3:F1000")
   
    ' boucle sur chaque cellule de "I"
    For Each cI In I
        If cI.Value <> "" Then
       
            ' boucle sur chaque cellule de "J"
            For Each cJ In J
                If cJ.Value = "" Then
                    Sheets("commande client").Select
                    cI.Copy
                    Sheets(2).Select
                    Sheets("données commandes").Select
                    cJ.PasteSpecial
                    ' sortie forcée boucle sur "J"
                    Exit For
                End If
            Next
        End If
    Next
    Application.CutCopyMode = False
End Sub

CNTJC
3