Microsoft 365 MACRO pour détecter une cellule de couleur et créer une colonne

[Guileo]

Bonjour à tous,

Dans le cadre d'un projet perso, j'ai besoin d'une macro qui agit sur un tableau que j'obtiens avec un export de logiciel.
Le tableau est dans le fichier excel ci-joint avec les explications de la macro.
J'ai essayée des choses mais je suis trop novice pour réussir ...

Pouvez-vous me donner votre macro d'expert pour ce sujet

Très bonne journée à vous.
Guil

 

[soan]

Bonjour Guileo,

bienvenue sur le site XLD ! 🙂

ton fichier en retour ; fais Ctrl e ➯ travail effectué :

ça a ajouté 3 colonnes devant l'ancienne colonne J pour David, Louise, et Simon.

➯ maintenant, la colonne "Désignation" se retrouve en colonne M. 😊

---

code VBA de Module1 (49 lignes) :

Option Explicit

Const cf& = 5287936 'couleur de fond : vert foncé

Dim nci% 'n° col devant laquelle insérer 1 col ; au départ : J = 10
Dim ncv% 'n° colonne à vérifier ; au départ, pour la colonne AK : 37
Dim ncf As Byte 'nombre de colonnes faites ; au départ : 0 colonne
Dim dlg& 'dernière ligne utilisée ; ce sera selon la colonne A

Private Sub Job() 'pour traiter chaque colonne l'une après l'autre,
                  'à partir de la colonne cdL / ncv : AK / 37
  Dim k&, n&, i&
  For i = 7 To dlg
    If Cells(i, ncv).Interior.Color = cf Then
      n = n + 1 'nb de cellules de fond cf dans la colonne ncv
      If n = 1 Then 'pour la 1ère cellule de fond cf
        Columns(nci).Insert 2, 0: nci = nci + 1: ncv = ncv + 1
        k = nci - 1
        With Cells(4, k)
          .Borders(9).Color = 12566463: .Borders(9).LineStyle = 1
          With .Offset(-1).Resize(5)
            .Borders(10).Color = 12566463: .Borders(10).LineStyle = 1
            .Borders(7).Color = 12566463: .Borders(7).LineStyle = 1
          End With
          With .Offset(1).Resize(4).Borders(12)
            .Color = 12566463: .LineStyle = 1: .Weight = 1
          End With
          .Value = Cells(3, ncv)
        End With
      End If
      With Cells(i, k)
        .HorizontalAlignment = 4: .IndentLevel = 1
        .NumberFormat = "#,##0.0000;-#,##0.0000;"
        .Value = Cells(i, ncv)
      End With
    End If
  Next i
  ncf = ncf + 1: ncv = ncv + 1
End Sub

Sub Essai()
  Const cdL$ = "AK" 'colonne de départ en Lettres : AK
  Const nct As Byte = 6 'nombre de colonnes à traiter : 6 (de AK à AP)
  nci = 10 'n° col devant laquelle insérer 1 col ; au départ : J = 10
  ncv = Columns(cdL).Column: dlg = Cells(Rows.Count, 1).End(3).Row
  Application.ScreenUpdating = 0: ncf = 0
  Do: Job: Loop Until ncf = nct
End Sub

si besoin, tu peux demander une adaptation.
à te lire pour avoir ton avis. 😉

soan