VBA Excel : Reproduction de mise en forme

Fermé

Zawzou - 24 août 2011 à 12:22
Utilisateur anonyme - 24 août 2011 à 17:14

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 ?

A voir également:

VBA Excel : Reproduction de mise en forme
Liste déroulante excel - Guide
Formule excel - Guide
Si et excel - Guide
Aller à la ligne excel - Guide
Mise en forme conditionnelle excel - Guide

1 réponse

Réponse 1 / 1

Utilisateur anonyme
Modifié par Lupin.PC4 le 24/08/2011 à 17:46

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

Discussions similaires

Excel VBA : Récupérer la valeur d'une cellule

Discussions similaires

Newsletters