Microsoft 365 Mise en forme d'un tableau via VBA

Bonsoir à tous,

je vous sollicite à nouveau pour une mise en forme d'un tableau via une macro à enregistrer dans mes macros personnelles.

Je vous joins un fichier anonymisé en exemple avec l'onglet 1(activite_agent) qui est le fichier d'origine avec un deuxième onglet qui est la mise en forme souhaitée:
1) supprimer la première ligne
2) dans la colonne C supprimer toutes les lignes qui ne contiennent pas total
3) dé-fusionner les colonnes C, D, E et F.
4) colonne A:
- remplacer Chalons par CNMR(maj)
- Remplacer Clermont par CNMR(maj)
- Supprimer le préfixe Site_SC_ pour ne garder que le suffixe
- supprime le préfixe Site_SD_ pour ne garde que le suffixe (dans le fichier il n'y en a pas mais suivant les journées il peut y en avoir)
5) Supprimer les colonnes T et U.

J'espère grâce à vous et votre site y arriver seul un jour.

En tous les cas merci d'avance à vous tous pour votre aide
Bonne soirée
 

Pièces jointes

  • Copie de 06___Activite_des_agents_anonyme.xls
    275 KB · Affichages: 18
Solution
bonjour @cp4 @TooFatBoy
voilà des copies d'écran
Regarde la pièce jointe 1154398
Regarde la pièce jointe 1154400
Regarde la pièce jointe 1154401
voilà ce qui se produit j'ai bien changé le nom qui est toujours activite_agent dans les mails que je reçois chaque jour avec ce rapport.
je suis bien dans mes macros personnelles
du coup je ne comprends pas
essaie avec ce code modifié
VB:
Option Explicit

Sub Mise_En_Forme3()
   Dim nb As Integer, i As Integer, tb
   Dim Plg As Range

  
   With ActiveSheet
      .Rows(1).Delete   'supprimer 1ère ligne
      ' supprimer les lignes visibles du filtre dont critère en colonne 3 est différent de total
      Set Plg = .Range("A1:U" & .Range("A" & Rows.Count).End(xlUp).Row)
      Plg.AutoFilter field:=3, Criteria1:="<>*TOTAL*"...
Bonsoir,
Un essai avec Power Query
bonjour,
le résultat est conforme à ce que je souhaite mais je ne connais pas du tout power query.
Ce fichier je le reçois tous les jours par mail et je dois le mettre en forme tous les jours.
Nous sommes plusieurs à pouvoir le mettre en forme, est ce faisable facilement comme l'exécution d'une macro?
Bien à vous
 

cp4

XLDnaute Barbatruc
Bonjour @Lolo le normand ;), @OKBI :),

un essai à tester.
VB:
Option Explicit

Sub Mise_En_Forme()
   Dim F As Worksheet, nb As Integer, i As Integer, tb

   Set F = ThisWorkbook.Sheets("activite_agent (2)") '**nom feuille à adapter**
   With F
      .Rows(1).Delete
      nb = .Cells(Rows.Count, 3).End(xlUp).Row
      For i = nb To 2 Step -1
         If .Cells(i, 3) <> "TOTAL" Then .Rows(i).Delete
      Next i

      nb = .Cells(Rows.Count, 1).End(xlUp).Row

      For i = 1 To nb
         If .Cells(i, 3).MergeCells Then .Cells(i, 3).UnMerge
         If .Cells(i, 19).MergeCells Then .Cells(i, 19).UnMerge

         If .Cells(i, 3).Offset(0, -2) = "Chalons" Then .Cells(i, 3).Offset(0, -2) = "CNMR"
         If .Cells(i, 3).Offset(0, -2) = "Clermont" Then .Cells(i, 3).Offset(0, -2) = "CNMR"

         tb = Split(.Cells(i, 3).Offset(0, -2), "_")
         If UBound(tb) <> 0 Then .Cells(i, 3).Offset(0, -2) = tb(UBound(tb))
      Next i
      .Columns("T:U").Delete Shift:=xlToLeft
   End With
   MsgBox "Traitement terminé!"
End Sub
Bonne journée
 
Dernière édition:
Bonjour @Lolo le normand ;), @OKBI :),

un essai à tester.
VB:
Option Explicit

Sub Mise_En_Forme()
   Dim F As Worksheet, nb As Integer, i As Integer, tb

   Set F = ThisWorkbook.Sheets("activite_agent (2)") '**nom feuille à adapter**
   With F
      .Rows(1).Delete
      nb = .Cells(Rows.Count, 3).End(xlUp).Row
      For i = nb To 2 Step -1
         If .Cells(i, 3) <> "TOTAL" Then .Rows(i).Delete
      Next i

      nb = .Cells(Rows.Count, 1).End(xlUp).Row

      For i = 1 To nb
         If .Cells(i, 3).MergeCells Then .Cells(i, 3).UnMerge
         If .Cells(i, 19).MergeCells Then .Cells(i, 19).UnMerge

         If .Cells(i, 3).Offset(0, -2) = "Chalons" Then .Cells(i, 3).Offset(0, -2) = "CNMR"
         If .Cells(i, 3).Offset(0, -2) = "Clermont" Then .Cells(i, 3).Offset(0, -2) = "CNMR"

         tb = Split(.Cells(i, 3).Offset(0, -2), "_")
         If UBound(tb) <> 0 Then .Cells(i, 3).Offset(0, -2) = tb(UBound(tb))
      Next i
      .Columns("T:U").Delete Shift:=xlToLeft
   End With
   MsgBox "Traitement terminé!"
End Sub
Bonne journée
Bonsoir,

J'ai ce bug sur votre code Set F = ThisWorkbook.Sheets("activite_agent")
j'ai adapté le nom de la feuille mais j'ai dû me tromper dans l'écriture.
Sachant que le nom de la feuille est toujours activite_agent.
Merci pour votre éclairage
Bien à vous
 

cp4

XLDnaute Barbatruc
Bonjour,

@Lolo le normand : Un peu plus rapide, on supprime les lignes non concernées d'un coup. Dans le précédent code on utilisait une boucle sur toutes les lignes d'où un temps plus long d’exécution.
VB:
Option Explicit

Sub Mise_En_Forme2()
   Dim F As Worksheet, nb As Integer, i As Integer, tb
   Dim Plg As Range

   Set F = ThisWorkbook.Sheets("activite_agent (2)") 'nom feuille à adapter
   With F
      .Rows(1).Delete   'supprimer 1ère ligne
      ' supprimer les lignes visibles du filtre dont critère en colonne 3 est différent de total
      Set Plg = .Range("A1:U" & .Range("A" & Rows.Count).End(xlUp).Row)
      Plg.AutoFilter field:=3, Criteria1:="<>*TOTAL*"   'application du filtre
      Application.DisplayAlerts = False   'désactivation message d'alerte suppression
      Plg.Offset(1).SpecialCells(xlCellTypeVisible).Delete   'suppression des lignes
      Application.DisplayAlerts = True
      .AutoFilterMode = False   'désactivation filtre
      '------------------
      nb = .Cells(Rows.Count, 1).End(xlUp).Row 'derniere ligne non vide en colonne 1

      For i = 1 To nb
         If .Cells(i, 3).MergeCells Then .Cells(i, 3).UnMerge
         If .Cells(i, 19).MergeCells Then .Cells(i, 19).UnMerge
         If .Cells(i, 3).Offset(0, -2) = "Chalons" Then .Cells(i, 3).Offset(0, -2) = "CNMR"
         If .Cells(i, 3).Offset(0, -2) = "Clermont" Then .Cells(i, 3).Offset(0, -2) = "CNMR"

         tb = Split(.Cells(i, 3).Offset(0, -2), "_")
         If UBound(tb) <> 0 Then .Cells(i, 3).Offset(0, -2) = tb(UBound(tb))
      Next i
      .Columns("T:U").Delete Shift:=xlToLeft
   End With
   MsgBox "Traitement terminé!"
End Sub
 
Bonjour,

@Lolo le normand : Un peu plus rapide, on supprime les lignes non concernées d'un coup. Dans le précédent code on utilisait une boucle sur toutes les lignes d'où un temps plus long d’exécution.
VB:
Option Explicit

Sub Mise_En_Forme2()
   Dim F As Worksheet, nb As Integer, i As Integer, tb
   Dim Plg As Range

   Set F = ThisWorkbook.Sheets("activite_agent (2)") 'nom feuille à adapter
   With F
      .Rows(1).Delete   'supprimer 1ère ligne
      ' supprimer les lignes visibles du filtre dont critère en colonne 3 est différent de total
      Set Plg = .Range("A1:U" & .Range("A" & Rows.Count).End(xlUp).Row)
      Plg.AutoFilter field:=3, Criteria1:="<>*TOTAL*"   'application du filtre
      Application.DisplayAlerts = False   'désactivation message d'alerte suppression
      Plg.Offset(1).SpecialCells(xlCellTypeVisible).Delete   'suppression des lignes
      Application.DisplayAlerts = True
      .AutoFilterMode = False   'désactivation filtre
      '------------------
      nb = .Cells(Rows.Count, 1).End(xlUp).Row 'derniere ligne non vide en colonne 1

      For i = 1 To nb
         If .Cells(i, 3).MergeCells Then .Cells(i, 3).UnMerge
         If .Cells(i, 19).MergeCells Then .Cells(i, 19).UnMerge
         If .Cells(i, 3).Offset(0, -2) = "Chalons" Then .Cells(i, 3).Offset(0, -2) = "CNMR"
         If .Cells(i, 3).Offset(0, -2) = "Clermont" Then .Cells(i, 3).Offset(0, -2) = "CNMR"

         tb = Split(.Cells(i, 3).Offset(0, -2), "_")
         If UBound(tb) <> 0 Then .Cells(i, 3).Offset(0, -2) = tb(UBound(tb))
      Next i
      .Columns("T:U").Delete Shift:=xlToLeft
   End With
   MsgBox "Traitement terminé!"
End Sub
@cp4 Bonjour et merci,
j'ai collé ce nouveau code mais j'ai toujours un bug sur le début du code que je ne comprends pas:
1667559753233.png

c'est pourtant le bon nom de la feuille.
Pouvez vous m'éclairer
Merci d'avance
Bien à vous
 
Bonjour,


Tu as copié le nom dans l'onglet, pour ensuite le coller dans la macro (ou inversement) ?
@TooFatBoy j'ai copié le code dans mes macros perso j'ai ouvert mon fichier et j'ai lancé la macro.
J'ai eu la fénêtre débogage donc j'ai copié le nom de l'onglet dans le code de la macro mais ça ne fonctionne toujours pas.
Le nom de l'onglet est toujours le même (c'est une extraction que je reçois tous les matins et le nom de l'onglet est toujours le même

j'ai ce message d'erreur:
1667563461176.png

bien cordialement
 
Dernière édition:

TooFatBoy

XLDnaute Barbatruc
Que je comprenne bien, tu as copié le nom de la feuille depuis l'onglet, puis tu l'as collé dans la macro, et alors le message d'erreur à changé ???
Ça veut donc dire qu'avant ça le nom de la feuille n'était pas le bon dans la macro.

Tu as un seul classeur ouvert ?
 
Que je comprenne bien, tu as copié le nom de la feuille depuis l'onglet, puis tu l'as collé dans la macro, et alors le message d'erreur à changé ???
Ça veut donc dire qu'avant ça le nom de la feuille n'était pas le bon dans la macro.

Tu as un seul classeur ouvert ?
Oui car si tu regardes dans le code écrit par @cp4 le nom de la feuille est "à adapter" mais en réalité il porte toujours le même nom le même que celui que tu trouves dans mon fichier d'origine.
Et oui j'ai qu'un seul classeur Excell ouvert
 

TooFatBoy

XLDnaute Barbatruc
Je viens d'allumer mon PC pour tester, et chez moi il n'y a pas de message d'erreur.

En revanche, si je mets un nom de feuille qui n'existe pas, j'ai bien le même message qu'en #11. ;)
(j'utilise Excel 2016)


Remarque : tu utilises Excel 365 et tu enregistres ton classeur au format Excel 97 ??? :oops:
 
Dernière édition:

Discussions similaires

Réponses
8
Affichages
506

Statistiques des forums

Discussions
315 152
Messages
2 116 796
Membres
112 864
dernier inscrit
sie_ouat