Copier Coller un peut special

[maval]

Bonjour,

Voila je recherche une façon de copier et de coller sur une autre feuille, un peu spécial.
Je m'explique: j'ai un code qui m'a été réaliser par Job75 que je salut et remercie au passage qui fonctionne très bien, mais vue l'évolution de mon projet j'aimerai lui apporter une modification un peut spécial.
J'aimerai que les N° et les noms des équipes avec un fond jaune généralement sont de "1 à 3" se trouvant dans l'onglet "Inscription", lorsqu'il se copie il se colle dans l'onglet "Trie" dans les cellules les cellules "F3:G3, F5:G5, F7:G7"si bien sur il y a 3 N° et les noms des équipes avec un fond jaune si il n'y a que deux "F3:G3, F5:G5" ect..

Mon code:

Sub Copier_Coller()
With Sheets("Inscription").[C3:D200] 'Copie
Sheets("Trie").[F3].Resize(.Rows.Count, .Columns.Count) = .Cells.Value 'Coller
Sheets("Trie").Activate
End With
End Sub

Je joint un exemple.

Je vous remercie de votre aide

Cordialement

Maval

 

[job75]

Re : Copier Coller un peut special

Bonsoir maval,

Voyez le fichier joint avec cette macro :

Sub Copier_Coller()
Dim plage As Range, cel As Range, tablo&(), n&, i&
With Sheets("Inscription").[C3:D200]
  Set plage = Sheets("Trie").[F3].Resize(.Rows.Count, .Columns.Count)
  .Copy plage 'pour les formats
  plage = .Cells.Value 'pour les valeurs
End With
For Each cel In plage.Columns(1).Cells
  If cel.Interior.ColorIndex <> xlNone Then
    ReDim Preserve tablo(n)
    tablo(n) = cel 'mémorisation
    cel = 0 'pour le tri (cellules jaunes en tête)
    n = n + 1
  End If
Next
plage.Sort plage(1), xlAscending, Header:=xlNo 'tri
If n Then
  For i = 0 To n - 1
    plage(1) = tablo(i) 'valeur mémorisée
    plage.Rows(1).Cut 'couper-insérer
    plage(1 + n + i, 1).Insert xlDown
  Next
End If
plage.Parent.Activate
End Sub

A+

 

[maval]

Re : Copier Coller un peut special

Bonsoir Job,

Merci beaucoup je pensai que se ne serai pas possible vraiment Nickel

Bonne soirée et merci encore

Max