Ajout d'une condition à une macro

Question

Voila, j'ai un classeur de 5 feuilles que je mets à jour par une requête web. Une fois ceci fait, je lance une macro pour mettre en forme ces 5 feuilles. Ce que j'aimerais, c'est qu'en lançant cette macro il y ait une condition pour chaque feuille : si A4 est renseignée faire la mise en forme sinon si A4 est vide il faut passer à la feuille suivante D'avance merci pour votre aide...

Yvouille · Answer

En n’ayant pas ton fichier à disposition, ni ta macro, c’est assez difficile de t’aider. A chaque fois que ton code sélectionne une autre feuille tu peux placer la condition If ActiveSheet.Range("A4") &lt;&gt; "" Then 'Code si A4 n'est pas vide End If Si tu ne t’en sors pas ainsi, merci de joindre ton fichier. Cordialement...

Yvouille · Answer

Selon ce que je peux voir – puisque tu ne me fournis toujours pas ton fichier – tu effectues ta mise en forme après la ligne ‘Met en couleur la police et centre les colonnes A, C et D’.

Tu modifies donc ta macro de cette manière, le code que je t’ai proposé étant la première et la dernière ligne ci-dessous :

.........
.........
If ActiveSheet.Range("A4") <> "" Then
'Met en couleur la police et centre les colonnes A, C et D
Range("A3:D200").Select
        With Selection.Font
        .Color = -4165632
        .TintAndShade = 0
         End With
      Selection.Font.Bold = True

    'Centre les colonnes A, C et D
   Range("A3:A200,C3:D200").Select
    Range("C3").Activate
    With Selection
        .HorizontalAlignment = xlCenter
                End With

      'Ajuste les colonnes A à D
   'Range("A3:A200,C3:D200").Select
   Range("C3:D200").Select
    Selection.Columns.AutoFit
    Columns("A:A").Select
    Selection.ColumnWidth = 8.22
    Columns("B:B").Select
    Selection.ColumnWidth = 33.78

'Met en forme le titre des colonnes
Range("A3").Select
    ActiveCell.FormulaR1C1 = "Rang"
    Range("B3").Select
    ActiveCell.FormulaR1C1 = "Athlète"
    Range("C3").Select
    ActiveCell.FormulaR1C1 = "Pays"
    Range("A3:D3").Select
    Selection.Font.Bold = True
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection.Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 12611584
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
End If
.........
.........

Ton code comporte par mal d’imperfections, mais je pense que ça irait assez long à le nettoyer un peu.

Si ça ne joue pas ainsi, il faut absolument que tu fournisses ton fichier.

Amicalement.

Yvouille · Answer

Re,

Je n’aime pas trop passer en privé, d’autant plus que ton fichier ne me semble pas si confidentiel.

Que tu actives ma proposition de modification de code ou que tu l’enlèves, ta macro bloque à l’endroit que tu indiques.

Par contre il semble que ton code bloque si la feuille traitée n’a rien d’inscrit dès la ligne 4. Je te propose alors de déplacer la première partie de ma proposition vers le haut, afin de ne rien effectuer sur les feuilles vides, comme sur la macro ci-dessous.

Sub MeFGene()
Dim Ws As Worksheet
Dim Dl As Long, i As Long
Dim L As Long
Dim L1 As Long

    Application.ScreenUpdating = False
    'Supprime la ligne vide avec le pays

    Sheets("Overhall").Select

For Each Ws In ActiveWorkbook.Worksheets 'sélectionne les feuilles une à une

Ws.Activate

If ActiveSheet.Range("A4") <> "" Then

 Application.ScreenUpdating = True
 Application.ScreenUpdating = False
    With Ws
        Dl = .Range("C" & Rows.Count).End(xlUp).Row
        For i = Dl To 4 Step -2
            Rows(i).Delete
        Next
    End With
    Set Ws = Nothing

   'Enlève le nom et prénom athlète en double
    Range("F4:F200").Select
       Range("F2").Select
    ActiveCell.FormulaR1C1 = " =GAUCHE(B4;NBCAR(B4)/2+1)"
    Range("F4").Select
    ActiveCell.FormulaR1C1 = "=LEFT(RC[-4],LEN(RC[-4])/2+1)"
    Range("F4").Select
    Selection.AutoFill Destination:=Range("F4:F200"), Type:=xlFillDefault
    Range("F4:F200").Select
    Selection.Copy
    Range("B4:B200").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("F4:F200").Select
    Application.CutCopyMode = False
    Selection.ClearContents

    'Recherche la 1ère ligne vide et supprime tout après le tableau
    L = Range("a3:a200").End(xlDown).Row + 1
L1 = Range("A" & Rows.Count).End(xlUp).Row
Rows(L & ":" & L1).Delete

   'Met en couleur la police et centre les colonnes A, C et D
Range("A3:D200").Select
        With Selection.Font
        .Color = -4165632
        .TintAndShade = 0
         End With
      Selection.Font.Bold = True

    'Centre les colonnes A, C et D
    Range("A3:A200,C3:D200").Select
    Range("C3").Activate
    With Selection
        .HorizontalAlignment = xlCenter
                End With

      'Ajuste les colonnes A à D
    'Range("A3:A200,C3:D200").Select
    Range("C3:D200").Select
    Selection.Columns.AutoFit
    Columns("A:A").Select
    Selection.ColumnWidth = 8.22
    Columns("B:B").Select
    Selection.ColumnWidth = 33.78

'Met en forme le titre des colonnes
 Range("A3").Select
    ActiveCell.FormulaR1C1 = "Rang"
    Range("B3").Select
    ActiveCell.FormulaR1C1 = "Athlète"
    Range("C3").Select
    ActiveCell.FormulaR1C1 = "Pays"
    Range("A3:D3").Select
    Selection.Font.Bold = True
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection.Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 12611584
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    End If

Application.ScreenUpdating = True
Next Ws
 Sheets("Overhall").Activate
 ActiveSheet.Range("A2").Select
   End Sub

Comme je te l’ai déjà dit, le reste de ton fichier est une vraie usine à gaz et je ne sais pas trop si la modification proposée n’a pas d’influence à d’autres endroits.

Amicalement.