Macro copier coller colonnes suivant la couleur de l'entête

[bloublou]

Bonjour,

Je revenais vers vous concernant une macro VBA qui pourrait faire suivant la couleur de l'entête :
-Copier de colonne sur une autre feuille suivant l'entête en jaune
- Et comme je voudrais pas changer l'extension de mon fichier xlsx en xlsm ,je souhaiterais qu'elle soit dispo dans ma barre de formules perso comme :

Sub ColonneJaune(control As IRibbonControl)
Macro XXX
End Sub

Serait ce la bonne solution et est-ce que vous pouvez m'aider dans ma démarche ?

Merci

BlouBlou

 

[Robert]

Re : Macro copier coller colonnes suivant la couleur de l'entête

Bonsoir Bloublou, bonsoir le forum,

Cette macro a copier dans ton classeur de macro personnelles PERSO.XLS. Tu pourras ensuite l'utiliser dans n'importe quel fichier ouvert :

Public Sub CoJaunes()
Dim B As Object 'déclare la variable B (Onglet Base)
Dim I As Object 'déclare la variable I (Onglet Import)
Dim DC As Integer 'déclare la variable DC (Dernière Colonne)
Dim J As Integer 'déclare la variable J (incrément)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)

On Error Resume Next 'gestion des erreur (en cas d'erreur passe à la ligne suivante
Set B = ActiveWorkbook.Sheets("Base") 'définit l'onglet B (génère une erreur si l'onglet "Base" n'existe pas)
Set I = ActiveWorkbook.Sheets("Import") 'définit l'onglet I (génère une erreur si l'onglet "Import" n'existe pas)
If Err <> 0 Then 'condition : si une erreur a été générée
    Err.Clear 'supprime l'erreur
    MsgBox "Le classeur actif ne contient pas d'onglet nommé [Base] ou [Import]. Impossible d'éxécuter la macro !" 'message
    Exit Sub 'sort de la procédure
End If 'fin de la condition
On Error GoTo 0 'annule la gestion des erreurs
DC = B.Cells(1, Application.Columns.Count).End(xlToLeft).Column 'définit la dernière colonne éditée DC de la ligne 1 de l'onglet B
For J = 1 To DC 'boucle de 1 à DC
    If B.Cells(1, J).Interior.ColorIndex = 6 Then 'condition : si la couleur du fond de la cellule est jaune
        'définit la cellule de destination DEST
        Set DEST = IIf(I.Range("A1").Value = "", I.Range("A1"), I.Cells(1,  Application.Columns.Count).End(xlToLeft).Offset(0, 1))
        B.Columns(J).Copy DEST 'copie la colonne et la colle dans DEST
    End If 'fin de la condition
Next J 'prochaine colonne de la boucle
End Sub

 

[bloublou]

Re : Macro copier coller colonnes suivant la couleur de l'entête

Bonjour à tous, Bonjour Robert,

Merci beaucoup pour ta macro ca marche vraiment bien

En plus elle est commentée Trop de la balle

Bonne journée à toi

BlouBlou

 

[bloublou]

Re : Macro copier coller colonnes suivant la couleur de l'entête

Re le forum, Re Robert

Une derniere question si je veux copier coller les colonnes avec un collage spécial :

B.Columns(J).Copy DEST = si je veux faire un collage special valeur et format, comme je l'insère dans le code ?


Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

Merci

BlouBlou

 

[Robert]

Re : Macro copier coller colonnes suivant la couleur de l'entête

Bonjour Bloublou, bonjour le forum,

Plutôt comme ça (non testé) :

Set DEST = IIf(I.Range("A1").Value = "", I.Range("A1"), I.Cells(1, Application.Columns.Count).End(xlToLeft).Offset(0, 1))
B.Columns(J).Copy 'copie la colonne J
DEST.PasteSpecial (xlPasteFormats) 'colle dans DEST les formats
DEST.PasteSpecial (xlPasteValues) 'colle dans DEST les valeurs
Application.CutCopyMode = False 'supprime le clognotement des cellules copiées

 

[bloublou]

Re : Macro copier coller colonnes suivant la couleur de l'entête

Bonjour Robert, le forum,

Ca marche nickel

Merci beaucoup pour toute ton aide

BlouBlou