VBA Excel : Reproduction de mise en forme

Zawzou -  
 Utilisateur anonyme -
Bonjour à tous,

J'étais déjà là hier et me voilà avec un nouveau soucis qui me bloque, je vous expose mon code : 

Dim i As Integer
For i = 3 To 198

Worksheets("1er semestre").Activate

    If Worksheets("1er semestre").Cells(5, i).Text = "L" Then
    ActiveSheet.Cells(5, i).EntireColumn.Select
    Selection.Copy
    End If
    
    If Worksheets("1er semestre").Cells(5, i).Text = "S" Then
    Worksheets("1er semestre").Select
    ActiveSheet.Cells(5, i).EntireColumn.Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    End If

Next i


Dim j As Integer
For j = 3 To 198

    If Worksheets("1er semestre").Cells(5, j).Text = "M" Then
    Worksheets("1er semestre").Select
    ActiveSheet.Cells(5, j).EntireColumn.Select
    Selection.Copy
    End If
    
    If Worksheets("1er semestre").Cells(5, j).Text = "D" Then
    Worksheets("1er semestre").Select
    ActiveSheet.Cells(5, j).EntireColumn.Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    End If

Next j


------
Le but étant donc de reproduire la mise en forme d'une colonne si à sa ligne 5 il y a un L, et de la reproduire de partout sur les colonnes où à la ligne 5 il y a un S. Et la même chose si à la ligne 5 il y a un M que sa mise en forme soit reproduite sur les colonnes où à la ligne 5 il y a un D...

Le soucis est que pour ma première formule ça fonctionne très, dès qu'on passe à la seconde ça ne fonctionne plus, j'ai plusieurs formules de ce genre à la suite et peut importe celle que je mets le débogage se met sur :
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

Et je ne comprend pas pourquoi... J'ai testé si la copie se faisait bien et ça fonctionne, c'est vraiment au moment du collage qu'il y a un problème. Mais pourquoi cela fonctionne pour la première formule et pas la seconde ?

1 réponse

  1. Utilisateur anonyme
     
    Bonjour,

    Suggestion : 

    Sub MiseEnForme()   

    Dim i As Integer, j As Integer   
      
    Application.ScreenUpdating = False  
    With Worksheets("1er semestre")   
       
        For i = 3 To 198   
            
            If (.Cells(5, i).Value = "L") Then   
                .Cells(5, i).EntireColumn.Select   
                Selection.Copy   
                   
                For j = (i + 1) To 198   
                    If (.Cells(5, j).Value = "S") Then   
                        .Cells(5, j).EntireColumn.Select   
                        Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _   
                            SkipBlanks:=False, Transpose:=False   
                    End If   
                Next j   
                Application.CutCopyMode = False   
            End If   
               
               
        Next i   
           
        For i = 3 To 198   
           
            If (.Cells(5, i).Value = "M") Then   
                .Cells(5, i).EntireColumn.Select   
                Selection.Copy   
                For j = (i+1) To 198   
                    If (.Cells(5, j).Value = "D") Then   
                        .Cells(5, j).EntireColumn.Select   
                        Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _   
                            SkipBlanks:=False, Transpose:=False   
                    End If   
                Next j   
                Application.CutCopyMode = False   
            End If   
               
        Next i   
       
        .Cells(1, 1).Select  
    End With  
    Application.ScreenUpdating = True  

End Sub   
'


    désolé, plusieurs modifs :-)

    Cdt

    Lupin
    0