Copier Coller cellules discontinues dans une autre feuille

Bonjour à tous,

Je besoin de copier les cellules de B à G + K de la feuille "Demande" seulement SI "J" est égal à "X" et de les coller de A à G dans la feuilles "Transition".

Je bug complètement. Je suis arrivée de copier la ligne complète mais pas seulement ma plage de cellules.

Je vous remercie par avance de vos réponses !

Bonjour KiKiMeu.

Je te propose une première solution.

L'idée est de passer par un tableau virtuel et l'utilisation d'un dictionnaire.

Le code :

Option Explicit

Sub Transfert_Transition()
'Déclaration des variables
Dim i&, j&, l&, t()
Dim d As Object: Set d = CreateObject("scripting.dictionary")

'On enregistre le tableau dans un tableau virtuel
'Plus de fluidité en cas de grand tableau
With Sheets("Demande")
    l = .Cells.Find("*", , , , xlByRows, xlPrevious).Row
    t = .Range(.Cells(2, 1), .Cells(l, 11)).Value
End With

l = 1
'On boucle le tableau virtuel
For i = LBound(t) To UBound(t)
    'Si la dixième colonne = x alors
    If UCase(t(i, 10)) = "X" Then
        'On boucle les colonnes où nous souhaitons récupérer les valeurs
        For j = 2 To 7
            'Si la clé existe déjà dans le dictionnaire
            If d.exists(l) Then
                'On concatène la valeur suivante avec un ":" entre
                d(l) = d(l) & ":" & t(i, j)
                'Sinon on ajoute la première valeur
                Else: d(l) = t(i, j)
            End If
        Next j
        'Ensuite nous ajoutons la dernière colonne concaténée
        d(l) = d(l) & ":" & t(i, 11)
        'On incrémente l de 1, ce qui correspond à l'index du dictionnaire
        l = l + 1
    End If
Next i

With Sheets("Transition")
    'On cherche la dernière ligne remplie
    l = .Cells.Find("*", , , , xlByRows, xlPrevious).Row
        'On boucle le dictionnaire de 1 à la quantité de clés
        For i = 1 To d.Count
            'Split permet de découper notre item
            'C'était l'intérêt d'espacer les valeurs par des ":"
            .Cells(l, 1).Offset(i).Resize(, 7).Value = Split(d(i), ":")
        Next i
End With
End Sub

MERCI beaucoup thebenoit59 , vous êtes formidable et d'une rapidité ! Encore merci

Bonjour à tous

Un essai à tester.

Bye !

FORMIDABLE !!! Merci

Rechercher des sujets similaires à "copier coller discontinues feuille"