XL 2016 Equilibrage gestion de comptes

obyone

XLDnaute Occasionnel
bonjour,
lors de la verifications de mes comptes j'ai une macro qui transfere les lignes dans un tableau pour les verifier puis si les compte sont bon les retransfere dans l'autre sens.
ce macro fonctionne mais elle devient beaucoup trop longue (10minutes pour traiter 150 lignes) y a-t-il un moyen de la simplifier pour la rendre plus réactive.

merci d'avance

Oby1

VB:
Sub Equilibrage_CommandButton1_Cliquer()
' copie si l'Equilibrage est OK
Dim Lequ As Long
If Sheets("Equilibrage").Cells(3, 4) = "0" Then
    If Sheets("Equilibrage").Cells(1, 1) = "Boursorama" Then
        With Sheets("Equilibrage")
                Range("Tableau112").Select
                Selection.Borders(xlDiagonalDown).LineStyle = xlNone
                Selection.Borders(xlDiagonalUp).LineStyle = xlNone
                Selection.Borders(xlEdgeLeft).LineStyle = xlNone
                Selection.Borders(xlEdgeTop).LineStyle = xlNone
                Selection.Borders(xlEdgeBottom).LineStyle = xlNone
                Selection.Borders(xlEdgeRight).LineStyle = xlNone
                Selection.Borders(xlInsideVertical).LineStyle = xlNone
                Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
                    With Selection.Interior
                        .Pattern = xlNone
                        .TintAndShade = 0
                        .PatternTintAndShade = 0
                    End With
                For Lequ = 6 To .[a65000].End(xlUp).Row
                    If .Cells(Lequ, 5) = "p" Then
                        With Sheets("Boursorama")
                                ligne = .[a65000].End(xlUp).Row + 1
                                 Sheets("Equilibrage").Cells(Lequ, 1).Cut .Cells(ligne, 1)
                                 Sheets("Equilibrage").Cells(Lequ, 2).Cut .Cells(ligne, 2)
                                 Sheets("Equilibrage").Cells(Lequ, 3).Cut .Cells(ligne, 3)
                                 Sheets("Equilibrage").Cells(Lequ, 4).Cut .Cells(ligne, 4)
                                 Sheets("Equilibrage").Cells(Lequ, 5).Cut .Cells(ligne, 5)
                                 Sheets("Equilibrage").Cells(Lequ, 6).Cut .Cells(ligne, 6)
                                 Sheets("Equilibrage").Cells(Lequ, 7).Cut .Cells(ligne, 7)
                                 ligne = ligne + 1
                                
                        End With
                    ElseIf .Cells(Lequ, 5) = "" Then
                        With Sheets("Boursorama")
                                  ligne = .[a65000].End(xlUp).Row + 1
                                 Sheets("Equilibrage").Cells(Lequ, 1).Cut .Cells(ligne, 1)
                                 Sheets("Equilibrage").Cells(Lequ, 2).Cut .Cells(ligne, 2)
                                 Sheets("Equilibrage").Cells(Lequ, 3).Cut .Cells(ligne, 3)
                                 Sheets("Equilibrage").Cells(Lequ, 4).Cut .Cells(ligne, 4)
                                 Sheets("Equilibrage").Cells(Lequ, 5).Cut .Cells(ligne, 5)
                                 Sheets("Equilibrage").Cells(Lequ, 6).Cut .Cells(ligne, 6)
                                 Sheets("Equilibrage").Cells(Lequ, 7).Cut .Cells(ligne, 7)
                                 ligne = ligne + 1
                        End With
                    ElseIf .Cells(Lequ, 5) = "r" Then
                        With Sheets("Boursorama")
                                  ligne = .[a65000].End(xlUp).Row + 1
                                 Sheets("Equilibrage").Cells(Lequ, 1).Cut .Cells(ligne, 1)
                                 Sheets("Equilibrage").Cells(Lequ, 2).Cut .Cells(ligne, 2)
                                 Sheets("Equilibrage").Cells(Lequ, 3).Cut .Cells(ligne, 3)
                                 Sheets("Equilibrage").Cells(Lequ, 4).Cut .Cells(ligne, 4)
                                 Sheets("Equilibrage").Cells(Lequ, 5).Cut .Cells(ligne, 5)
                                 Sheets("Equilibrage").Cells(Lequ, 6).Cut .Cells(ligne, 6)
                                 Sheets("Equilibrage").Cells(Lequ, 7).Cut .Cells(ligne, 7)
                                 ligne = ligne + 1
                        End With
                    End If
                Next
    'supprime les lignes si la premiere celulle est vide
    
        Application.ScreenUpdating = False
        Application.DisplayAlerts = False
        .Activate
        .[a65000].End(xlUp).Select
      
        Do
            If IsEmpty(ActiveCell) Then
            ActiveCell.EntireRow.Delete
            End If
            ActiveCell.Offset(-1, 0).Select
            Loop Until ActiveCell.Row = 1
            Application.ScreenUpdating = True
            Application.DisplayAlerts = True
        End With
        
     'supprime les lignes si la premiere celulle de la feuille Boursorama est vide
    
        With Sheets("Boursorama")
        Application.ScreenUpdating = False
        Application.DisplayAlerts = False
        .Activate
        .[a65000].End(xlUp).Select
        
    
        Do
            If IsEmpty(ActiveCell) Then
            ActiveCell.EntireRow.Delete
            End If
            ActiveCell.Offset(-1, 0).Select
            Loop Until ActiveCell.Row = 1
            Application.ScreenUpdating = True
            Application.DisplayAlerts = True
        Dim LignR
        ' masque les lignes avec r
        For LignR = .Range("A65536").End(xlUp).Row To 5 Step -1
        If .Cells(LignR, 5) = "r" Then .Rows(LignR).Hidden = True
        Next
        End With


    ElseIf Sheets("Equilibrage").Cells(1, 1) = "Visa Laurent" Then
       With Sheets("Equilibrage")
            Range("Tableau112").Select
                Selection.Borders(xlDiagonalDown).LineStyle = xlNone
                Selection.Borders(xlDiagonalUp).LineStyle = xlNone
                Selection.Borders(xlEdgeLeft).LineStyle = xlNone
                Selection.Borders(xlEdgeTop).LineStyle = xlNone
                Selection.Borders(xlEdgeBottom).LineStyle = xlNone
                Selection.Borders(xlEdgeRight).LineStyle = xlNone
                Selection.Borders(xlInsideVertical).LineStyle = xlNone
                Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
                    With Selection.Interior
                        .Pattern = xlNone
                        .TintAndShade = 0
                        .PatternTintAndShade = 0
                    End With
                For Lequ = 6 To .[a65000].End(xlUp).Row
                    If .Cells(Lequ, 5) = "p" Then
                        With Sheets("Visa Laurent")
                                ligne = .[a65000].End(xlUp).Row + 1
                                 Sheets("Equilibrage").Cells(Lequ, 1).Cut .Cells(ligne, 1)
                                 Sheets("Equilibrage").Cells(Lequ, 2).Cut .Cells(ligne, 2)
                                 Sheets("Equilibrage").Cells(Lequ, 3).Cut .Cells(ligne, 3)
                                 Sheets("Equilibrage").Cells(Lequ, 4).Cut .Cells(ligne, 4)
                                 Sheets("Equilibrage").Cells(Lequ, 5).Cut .Cells(ligne, 5)
                                 Sheets("Equilibrage").Cells(Lequ, 6).Cut .Cells(ligne, 6)
                                 Sheets("Equilibrage").Cells(Lequ, 7).Cut .Cells(ligne, 7)
                                 ligne = ligne + 1
                                
                        End With
                    ElseIf .Cells(Lequ, 5) = "" Then
                        With Sheets("Visa Laurent")
                                  ligne = .[a65000].End(xlUp).Row + 1
                                 Sheets("Equilibrage").Cells(Lequ, 1).Cut .Cells(ligne, 1)
                                 Sheets("Equilibrage").Cells(Lequ, 2).Cut .Cells(ligne, 2)
                                 Sheets("Equilibrage").Cells(Lequ, 3).Cut .Cells(ligne, 3)
                                 Sheets("Equilibrage").Cells(Lequ, 4).Cut .Cells(ligne, 4)
                                 Sheets("Equilibrage").Cells(Lequ, 5).Cut .Cells(ligne, 5)
                                 Sheets("Equilibrage").Cells(Lequ, 6).Cut .Cells(ligne, 6)
                                 Sheets("Equilibrage").Cells(Lequ, 7).Cut .Cells(ligne, 7)
                                 ligne = ligne + 1
                        End With
                    ElseIf .Cells(Lequ, 5) = "r" Then
                        With Sheets("Visa Laurent")
                                  ligne = .[a65000].End(xlUp).Row + 1
                                 Sheets("Equilibrage").Cells(Lequ, 1).Cut .Cells(ligne, 1)
                                 Sheets("Equilibrage").Cells(Lequ, 2).Cut .Cells(ligne, 2)
                                 Sheets("Equilibrage").Cells(Lequ, 3).Cut .Cells(ligne, 3)
                                 Sheets("Equilibrage").Cells(Lequ, 4).Cut .Cells(ligne, 4)
                                 Sheets("Equilibrage").Cells(Lequ, 5).Cut .Cells(ligne, 5)
                                 Sheets("Equilibrage").Cells(Lequ, 6).Cut .Cells(ligne, 6)
                                 Sheets("Equilibrage").Cells(Lequ, 7).Cut .Cells(ligne, 7)
                                 ligne = ligne + 1
                        End With
                    End If
                Next
    'supprime les lignes si la premiere celulle est vide
    
        Application.ScreenUpdating = False
        Application.DisplayAlerts = False
        .Activate
        .[a65000].End(xlUp).Select
      
        Do
            If IsEmpty(ActiveCell) Then
            ActiveCell.EntireRow.Delete
            End If
            ActiveCell.Offset(-1, 0).Select
            Loop Until ActiveCell.Row = 1
            Application.ScreenUpdating = True
            Application.DisplayAlerts = True
        End With
        
     'supprime les lignes si la premiere celulle de la feuille CCP est vide
    
        With Sheets("Visa Laurent")
        Application.ScreenUpdating = False
        Application.DisplayAlerts = False
        .Activate
        .[a65000].End(xlUp).Select
        
    
        Do
            If IsEmpty(ActiveCell) Then
            ActiveCell.EntireRow.Delete
            End If
            ActiveCell.Offset(-1, 0).Select
            Loop Until ActiveCell.Row = 1
            Application.ScreenUpdating = True
            Application.DisplayAlerts = True
            
        ' masque les lignes avec r
        For LignR = .Range("A65536").End(xlUp).Row To 5 Step -1
        If .Cells(LignR, 5) = "r" Then .Rows(LignR).Hidden = True
        Next
        End With
        
    ElseIf Sheets("Equilibrage").Cells(1, 1) = "Livret A Laurent" Then
       With Sheets("Equilibrage")
            Range("Tableau112").Select
                Selection.Borders(xlDiagonalDown).LineStyle = xlNone
                Selection.Borders(xlDiagonalUp).LineStyle = xlNone
                Selection.Borders(xlEdgeLeft).LineStyle = xlNone
                Selection.Borders(xlEdgeTop).LineStyle = xlNone
                Selection.Borders(xlEdgeBottom).LineStyle = xlNone
                Selection.Borders(xlEdgeRight).LineStyle = xlNone
                Selection.Borders(xlInsideVertical).LineStyle = xlNone
                Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
                    With Selection.Interior
                        .Pattern = xlNone
                        .TintAndShade = 0
                        .PatternTintAndShade = 0
                    End With
                For Lequ = 6 To .[a65000].End(xlUp).Row
                    If .Cells(Lequ, 5) = "p" Then
                        With Sheets("Livret A Laurent")
                                ligne = .[a65000].End(xlUp).Row + 1
                                 Sheets("Equilibrage").Cells(Lequ, 1).Cut .Cells(ligne, 1)
                                 Sheets("Equilibrage").Cells(Lequ, 2).Cut .Cells(ligne, 2)
                                 Sheets("Equilibrage").Cells(Lequ, 3).Cut .Cells(ligne, 3)
                                 Sheets("Equilibrage").Cells(Lequ, 4).Cut .Cells(ligne, 4)
                                 Sheets("Equilibrage").Cells(Lequ, 5).Cut .Cells(ligne, 5)
                                 Sheets("Equilibrage").Cells(Lequ, 6).Cut .Cells(ligne, 6)
                                 Sheets("Equilibrage").Cells(Lequ, 7).Cut .Cells(ligne, 7)
                                 ligne = ligne + 1
                                
                        End With
                    ElseIf .Cells(Lequ, 5) = "" Then
                        With Sheets("Livret A Laurent")
                                  ligne = .[a65000].End(xlUp).Row + 1
                                 Sheets("Equilibrage").Cells(Lequ, 1).Cut .Cells(ligne, 1)
                                 Sheets("Equilibrage").Cells(Lequ, 2).Cut .Cells(ligne, 2)
                                 Sheets("Equilibrage").Cells(Lequ, 3).Cut .Cells(ligne, 3)
                                 Sheets("Equilibrage").Cells(Lequ, 4).Cut .Cells(ligne, 4)
                                 Sheets("Equilibrage").Cells(Lequ, 5).Cut .Cells(ligne, 5)
                                 Sheets("Equilibrage").Cells(Lequ, 6).Cut .Cells(ligne, 6)
                                 Sheets("Equilibrage").Cells(Lequ, 7).Cut .Cells(ligne, 7)
                                 ligne = ligne + 1
                        End With
                    ElseIf .Cells(Lequ, 5) = "r" Then
                        With Sheets("Livret A Laurent")
                                  ligne = .[a65000].End(xlUp).Row + 1
                                 Sheets("Equilibrage").Cells(Lequ, 1).Cut .Cells(ligne, 1)
                                 Sheets("Equilibrage").Cells(Lequ, 2).Cut .Cells(ligne, 2)
                                 Sheets("Equilibrage").Cells(Lequ, 3).Cut .Cells(ligne, 3)
                                 Sheets("Equilibrage").Cells(Lequ, 4).Cut .Cells(ligne, 4)
                                 Sheets("Equilibrage").Cells(Lequ, 5).Cut .Cells(ligne, 5)
                                 Sheets("Equilibrage").Cells(Lequ, 6).Cut .Cells(ligne, 6)
                                 Sheets("Equilibrage").Cells(Lequ, 7).Cut .Cells(ligne, 7)
                                 ligne = ligne + 1
                        End With
                    End If
                Next
    'supprime les lignes si la premiere celulle est vide
    
        Application.ScreenUpdating = False
        Application.DisplayAlerts = False
        .Activate
        .[a65000].End(xlUp).Select
      
        Do
            If IsEmpty(ActiveCell) Then
            ActiveCell.EntireRow.Delete
            End If
            ActiveCell.Offset(-1, 0).Select
            Loop Until ActiveCell.Row = 1
            Application.ScreenUpdating = True
            Application.DisplayAlerts = True
        End With
        
     'supprime les lignes si la premiere celulle de la feuille CCP est vide
    
        With Sheets("Livret A Laurent")
        Application.ScreenUpdating = False
        Application.DisplayAlerts = False
        .Activate
        .[a65000].End(xlUp).Select
        
    
        Do
            If IsEmpty(ActiveCell) Then
            ActiveCell.EntireRow.Delete
            End If
            ActiveCell.Offset(-1, 0).Select
            Loop Until ActiveCell.Row = 1
            Application.ScreenUpdating = True
            Application.DisplayAlerts = True
            
        ' masque les lignes avec r
        For LignR = .Range("A65536").End(xlUp).Row To 5 Step -1
        If .Cells(LignR, 5) = "r" Then .Rows(LignR).Hidden = True
        Next
        End With
        
    ElseIf Sheets("Equilibrage").Cells(1, 1) = "Livret A Laurence" Then
       With Sheets("Equilibrage")
            Range("Tableau112").Select
                Selection.Borders(xlDiagonalDown).LineStyle = xlNone
                Selection.Borders(xlDiagonalUp).LineStyle = xlNone
                Selection.Borders(xlEdgeLeft).LineStyle = xlNone
                Selection.Borders(xlEdgeTop).LineStyle = xlNone
                Selection.Borders(xlEdgeBottom).LineStyle = xlNone
                Selection.Borders(xlEdgeRight).LineStyle = xlNone
                Selection.Borders(xlInsideVertical).LineStyle = xlNone
                Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
                    With Selection.Interior
                        .Pattern = xlNone
                        .TintAndShade = 0
                        .PatternTintAndShade = 0
                    End With
                For Lequ = 6 To .[a65000].End(xlUp).Row
                    If .Cells(Lequ, 5) = "p" Then
                        With Sheets("Livret A Laurence")
                                ligne = .[a65000].End(xlUp).Row + 1
                                 Sheets("Equilibrage").Cells(Lequ, 1).Cut .Cells(ligne, 1)
                                 Sheets("Equilibrage").Cells(Lequ, 2).Cut .Cells(ligne, 2)
                                 Sheets("Equilibrage").Cells(Lequ, 3).Cut .Cells(ligne, 3)
                                 Sheets("Equilibrage").Cells(Lequ, 4).Cut .Cells(ligne, 4)
                                 Sheets("Equilibrage").Cells(Lequ, 5).Cut .Cells(ligne, 5)
                                 Sheets("Equilibrage").Cells(Lequ, 6).Cut .Cells(ligne, 6)
                                 Sheets("Equilibrage").Cells(Lequ, 7).Cut .Cells(ligne, 7)
                                 ligne = ligne + 1
                                
                        End With
                    ElseIf .Cells(Lequ, 5) = "" Then
                        With Sheets("Livret A Laurence")
                                  ligne = .[a65000].End(xlUp).Row + 1
                                 Sheets("Equilibrage").Cells(Lequ, 1).Cut .Cells(ligne, 1)
                                 Sheets("Equilibrage").Cells(Lequ, 2).Cut .Cells(ligne, 2)
                                 Sheets("Equilibrage").Cells(Lequ, 3).Cut .Cells(ligne, 3)
                                 Sheets("Equilibrage").Cells(Lequ, 4).Cut .Cells(ligne, 4)
                                 Sheets("Equilibrage").Cells(Lequ, 5).Cut .Cells(ligne, 5)
                                 Sheets("Equilibrage").Cells(Lequ, 6).Cut .Cells(ligne, 6)
                                 Sheets("Equilibrage").Cells(Lequ, 7).Cut .Cells(ligne, 7)
                                 ligne = ligne + 1
                        End With
                    ElseIf .Cells(Lequ, 5) = "r" Then
                        With Sheets("Livret A Laurence")
                                  ligne = .[a65000].End(xlUp).Row + 1
                                 Sheets("Equilibrage").Cells(Lequ, 1).Cut .Cells(ligne, 1)
                                 Sheets("Equilibrage").Cells(Lequ, 2).Cut .Cells(ligne, 2)
                                 Sheets("Equilibrage").Cells(Lequ, 3).Cut .Cells(ligne, 3)
                                 Sheets("Equilibrage").Cells(Lequ, 4).Cut .Cells(ligne, 4)
                                 Sheets("Equilibrage").Cells(Lequ, 5).Cut .Cells(ligne, 5)
                                 Sheets("Equilibrage").Cells(Lequ, 6).Cut .Cells(ligne, 6)
                                 Sheets("Equilibrage").Cells(Lequ, 7).Cut .Cells(ligne, 7)
                                 ligne = ligne + 1
                        End With
                    End If
                Next
    'supprime les lignes si la premiere celulle est vide
    
        Application.ScreenUpdating = False
        Application.DisplayAlerts = False
        .Activate
        .[a65000].End(xlUp).Select
      
        Do
            If IsEmpty(ActiveCell) Then
            ActiveCell.EntireRow.Delete
            End If
            ActiveCell.Offset(-1, 0).Select
            Loop Until ActiveCell.Row = 1
            Application.ScreenUpdating = True
            Application.DisplayAlerts = True
        End With
        
     'supprime les lignes si la premiere celulle de la feuille Livret A Laurence est vide
    
        With Sheets("Livret A Laurence")
        Application.ScreenUpdating = False
        Application.DisplayAlerts = False
        .Activate
        .[a65000].End(xlUp).Select
        
    
        Do
            If IsEmpty(ActiveCell) Then
            ActiveCell.EntireRow.Delete
            End If
            ActiveCell.Offset(-1, 0).Select
            Loop Until ActiveCell.Row = 1
            Application.ScreenUpdating = True
            Application.DisplayAlerts = True
            
        ' masque les lignes avec r
        For LignR = .Range("A65536").End(xlUp).Row To 5 Step -1
        If .Cells(LignR, 5) = "r" Then .Rows(LignR).Hidden = True
        Next
        End With
        
    ElseIf Sheets("Equilibrage").Cells(1, 1) = "Livret A Evan" Then
       With Sheets("Equilibrage")
            Range("Tableau112").Select
                Selection.Borders(xlDiagonalDown).LineStyle = xlNone
                Selection.Borders(xlDiagonalUp).LineStyle = xlNone
                Selection.Borders(xlEdgeLeft).LineStyle = xlNone
                Selection.Borders(xlEdgeTop).LineStyle = xlNone
                Selection.Borders(xlEdgeBottom).LineStyle = xlNone
                Selection.Borders(xlEdgeRight).LineStyle = xlNone
                Selection.Borders(xlInsideVertical).LineStyle = xlNone
                Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
                    With Selection.Interior
                        .Pattern = xlNone
                        .TintAndShade = 0
                        .PatternTintAndShade = 0
                    End With
                For Lequ = 6 To .[a65000].End(xlUp).Row
                    If .Cells(Lequ, 5) = "p" Then
                        With Sheets("Livret A Evan")
                                ligne = .[a65000].End(xlUp).Row + 1
                                 Sheets("Equilibrage").Cells(Lequ, 1).Cut .Cells(ligne, 1)
                                 Sheets("Equilibrage").Cells(Lequ, 2).Cut .Cells(ligne, 2)
                                 Sheets("Equilibrage").Cells(Lequ, 3).Cut .Cells(ligne, 3)
                                 Sheets("Equilibrage").Cells(Lequ, 4).Cut .Cells(ligne, 4)
                                 Sheets("Equilibrage").Cells(Lequ, 5).Cut .Cells(ligne, 5)
                                 Sheets("Equilibrage").Cells(Lequ, 6).Cut .Cells(ligne, 6)
                                 Sheets("Equilibrage").Cells(Lequ, 7).Cut .Cells(ligne, 7)
                                 ligne = ligne + 1
                                
                        End With
                    ElseIf .Cells(Lequ, 5) = "" Then
                        With Sheets("Livret A Evan")
                                  ligne = .[a65000].End(xlUp).Row + 1
                                 Sheets("Equilibrage").Cells(Lequ, 1).Cut .Cells(ligne, 1)
                                 Sheets("Equilibrage").Cells(Lequ, 2).Cut .Cells(ligne, 2)
                                 Sheets("Equilibrage").Cells(Lequ, 3).Cut .Cells(ligne, 3)
                                 Sheets("Equilibrage").Cells(Lequ, 4).Cut .Cells(ligne, 4)
                                 Sheets("Equilibrage").Cells(Lequ, 5).Cut .Cells(ligne, 5)
                                 Sheets("Equilibrage").Cells(Lequ, 6).Cut .Cells(ligne, 6)
                                 Sheets("Equilibrage").Cells(Lequ, 7).Cut .Cells(ligne, 7)
                                 ligne = ligne + 1
                        End With
                    ElseIf .Cells(Lequ, 5) = "r" Then
                        With Sheets("Livret A Evan")
                                  ligne = .[a65000].End(xlUp).Row + 1
                                 Sheets("Equilibrage").Cells(Lequ, 1).Cut .Cells(ligne, 1)
                                 Sheets("Equilibrage").Cells(Lequ, 2).Cut .Cells(ligne, 2)
                                 Sheets("Equilibrage").Cells(Lequ, 3).Cut .Cells(ligne, 3)
                                 Sheets("Equilibrage").Cells(Lequ, 4).Cut .Cells(ligne, 4)
                                 Sheets("Equilibrage").Cells(Lequ, 5).Cut .Cells(ligne, 5)
                                 Sheets("Equilibrage").Cells(Lequ, 6).Cut .Cells(ligne, 6)
                                 Sheets("Equilibrage").Cells(Lequ, 7).Cut .Cells(ligne, 7)
                                 ligne = ligne + 1
                        End With
                    End If
                Next
    'supprime les lignes si la premiere celulle est vide
    
        Application.ScreenUpdating = False
        Application.DisplayAlerts = False
        .Activate
        .[a65000].End(xlUp).Select
      
        Do
            If IsEmpty(ActiveCell) Then
            ActiveCell.EntireRow.Delete
            End If
            ActiveCell.Offset(-1, 0).Select
            Loop Until ActiveCell.Row = 1
            Application.ScreenUpdating = True
            Application.DisplayAlerts = True
        End With
        
     'supprime les lignes si la premiere celulle de la feuille Evan est vide
    
        With Sheets("Livret A Evan")
        Application.ScreenUpdating = False
        Application.DisplayAlerts = False
        .Activate
        .[a65000].End(xlUp).Select
        
    
        Do
            If IsEmpty(ActiveCell) Then
            ActiveCell.EntireRow.Delete
            End If
            ActiveCell.Offset(-1, 0).Select
            Loop Until ActiveCell.Row = 1
            Application.ScreenUpdating = True
            Application.DisplayAlerts = True
            
        ' masque les lignes avec r
        For LignR = .Range("A65536").End(xlUp).Row To 5 Step -1
        If .Cells(LignR, 5) = "r" Then .Rows(LignR).Hidden = True
        Next
        End With
        
    ElseIf Sheets("Equilibrage").Cells(1, 1) = "Livret A Elsa" Then
       With Sheets("Equilibrage")
            Range("Tableau112").Select
                Selection.Borders(xlDiagonalDown).LineStyle = xlNone
                Selection.Borders(xlDiagonalUp).LineStyle = xlNone
                Selection.Borders(xlEdgeLeft).LineStyle = xlNone
                Selection.Borders(xlEdgeTop).LineStyle = xlNone
                Selection.Borders(xlEdgeBottom).LineStyle = xlNone
                Selection.Borders(xlEdgeRight).LineStyle = xlNone
                Selection.Borders(xlInsideVertical).LineStyle = xlNone
                Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
                    With Selection.Interior
                        .Pattern = xlNone
                        .TintAndShade = 0
                        .PatternTintAndShade = 0
                    End With
                For Lequ = 6 To .[a65000].End(xlUp).Row
                    If .Cells(Lequ, 5) = "p" Then
                        With Sheets("Livret A Elsa")
                                ligne = .[a65000].End(xlUp).Row + 1
                                 Sheets("Equilibrage").Cells(Lequ, 1).Cut .Cells(ligne, 1)
                                 Sheets("Equilibrage").Cells(Lequ, 2).Cut .Cells(ligne, 2)
                                 Sheets("Equilibrage").Cells(Lequ, 3).Cut .Cells(ligne, 3)
                                 Sheets("Equilibrage").Cells(Lequ, 4).Cut .Cells(ligne, 4)
                                 Sheets("Equilibrage").Cells(Lequ, 5).Cut .Cells(ligne, 5)
                                 Sheets("Equilibrage").Cells(Lequ, 6).Cut .Cells(ligne, 6)
                                 Sheets("Equilibrage").Cells(Lequ, 7).Cut .Cells(ligne, 7)
                                 ligne = ligne + 1
                                
                        End With
                    ElseIf .Cells(Lequ, 5) = "" Then
                        With Sheets("Livret A Elsa")
                                  ligne = .[a65000].End(xlUp).Row + 1
                                 Sheets("Equilibrage").Cells(Lequ, 1).Cut .Cells(ligne, 1)
                                 Sheets("Equilibrage").Cells(Lequ, 2).Cut .Cells(ligne, 2)
                                 Sheets("Equilibrage").Cells(Lequ, 3).Cut .Cells(ligne, 3)
                                 Sheets("Equilibrage").Cells(Lequ, 4).Cut .Cells(ligne, 4)
                                 Sheets("Equilibrage").Cells(Lequ, 5).Cut .Cells(ligne, 5)
                                 Sheets("Equilibrage").Cells(Lequ, 6).Cut .Cells(ligne, 6)
                                 Sheets("Equilibrage").Cells(Lequ, 7).Cut .Cells(ligne, 7)
                                 ligne = ligne + 1
                        End With
                    ElseIf .Cells(Lequ, 5) = "r" Then
                        With Sheets("Livret A Elsa")
                                  ligne = .[a65000].End(xlUp).Row + 1
                                 Sheets("Equilibrage").Cells(Lequ, 1).Cut .Cells(ligne, 1)
                                 Sheets("Equilibrage").Cells(Lequ, 2).Cut .Cells(ligne, 2)
                                 Sheets("Equilibrage").Cells(Lequ, 3).Cut .Cells(ligne, 3)
                                 Sheets("Equilibrage").Cells(Lequ, 4).Cut .Cells(ligne, 4)
                                 Sheets("Equilibrage").Cells(Lequ, 5).Cut .Cells(ligne, 5)
                                 Sheets("Equilibrage").Cells(Lequ, 6).Cut .Cells(ligne, 6)
                                 Sheets("Equilibrage").Cells(Lequ, 7).Cut .Cells(ligne, 7)
                                 ligne = ligne + 1
                        End With
                    End If
                Next
    'supprime les lignes si la premiere celulle est vide
    
        Application.ScreenUpdating = False
        Application.DisplayAlerts = False
        .Activate
        .[a65000].End(xlUp).Select
      
        Do
            If IsEmpty(ActiveCell) Then
            ActiveCell.EntireRow.Delete
            End If
            ActiveCell.Offset(-1, 0).Select
            Loop Until ActiveCell.Row = 1
            Application.ScreenUpdating = True
            Application.DisplayAlerts = True
        End With
        
     'supprime les lignes si la premiere celulle de la feuille Elsa est vide
    
        With Sheets("Livret A Elsa")
        Application.ScreenUpdating = False
        Application.DisplayAlerts = False
        .Activate
        .[a65000].End(xlUp).Select
        
    
        Do
            If IsEmpty(ActiveCell) Then
            ActiveCell.EntireRow.Delete
            End If
            ActiveCell.Offset(-1, 0).Select
            Loop Until ActiveCell.Row = 1
            Application.ScreenUpdating = True
            Application.DisplayAlerts = True
            
        ' masque les lignes avec r
        For LignR = .Range("A65536").End(xlUp).Row To 5 Step -1
        If .Cells(LignR, 5) = "r" Then .Rows(LignR).Hidden = True
        Next
        End With
        
    ElseIf Sheets("Equilibrage").Cells(1, 1) = "PEA" Then
       With Sheets("Equilibrage")
            Range("Tableau112").Select
                Selection.Borders(xlDiagonalDown).LineStyle = xlNone
                Selection.Borders(xlDiagonalUp).LineStyle = xlNone
                Selection.Borders(xlEdgeLeft).LineStyle = xlNone
                Selection.Borders(xlEdgeTop).LineStyle = xlNone
                Selection.Borders(xlEdgeBottom).LineStyle = xlNone
                Selection.Borders(xlEdgeRight).LineStyle = xlNone
                Selection.Borders(xlInsideVertical).LineStyle = xlNone
                Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
                    With Selection.Interior
                        .Pattern = xlNone
                        .TintAndShade = 0
                        .PatternTintAndShade = 0
                    End With
                For Lequ = 6 To .[a65000].End(xlUp).Row
                    If .Cells(Lequ, 5) = "p" Then
                        With Sheets("PEA")
                                ligne = .[a65000].End(xlUp).Row + 1
                                 Sheets("Equilibrage").Cells(Lequ, 1).Cut .Cells(ligne, 1)
                                 Sheets("Equilibrage").Cells(Lequ, 2).Cut .Cells(ligne, 2)
                                 Sheets("Equilibrage").Cells(Lequ, 3).Cut .Cells(ligne, 3)
                                 Sheets("Equilibrage").Cells(Lequ, 4).Cut .Cells(ligne, 4)
                                 Sheets("Equilibrage").Cells(Lequ, 5).Cut .Cells(ligne, 5)
                                 Sheets("Equilibrage").Cells(Lequ, 6).Cut .Cells(ligne, 6)
                                 Sheets("Equilibrage").Cells(Lequ, 7).Cut .Cells(ligne, 7)
                                 ligne = ligne + 1
                                
                        End With
                    ElseIf .Cells(Lequ, 5) = "" Then
                        With Sheets("PEA")
                                  ligne = .[a65000].End(xlUp).Row + 1
                                 Sheets("Equilibrage").Cells(Lequ, 1).Cut .Cells(ligne, 1)
                                 Sheets("Equilibrage").Cells(Lequ, 2).Cut .Cells(ligne, 2)
                                 Sheets("Equilibrage").Cells(Lequ, 3).Cut .Cells(ligne, 3)
                                 Sheets("Equilibrage").Cells(Lequ, 4).Cut .Cells(ligne, 4)
                                 Sheets("Equilibrage").Cells(Lequ, 5).Cut .Cells(ligne, 5)
                                 Sheets("Equilibrage").Cells(Lequ, 6).Cut .Cells(ligne, 6)
                                 Sheets("Equilibrage").Cells(Lequ, 7).Cut .Cells(ligne, 7)
                                 ligne = ligne + 1
                        End With
                    ElseIf .Cells(Lequ, 5) = "r" Then
                        With Sheets("PEA")
                                  ligne = .[a65000].End(xlUp).Row + 1
                                 Sheets("Equilibrage").Cells(Lequ, 1).Cut .Cells(ligne, 1)
                                 Sheets("Equilibrage").Cells(Lequ, 2).Cut .Cells(ligne, 2)
                                 Sheets("Equilibrage").Cells(Lequ, 3).Cut .Cells(ligne, 3)
                                 Sheets("Equilibrage").Cells(Lequ, 4).Cut .Cells(ligne, 4)
                                 Sheets("Equilibrage").Cells(Lequ, 5).Cut .Cells(ligne, 5)
                                 Sheets("Equilibrage").Cells(Lequ, 6).Cut .Cells(ligne, 6)
                                 Sheets("Equilibrage").Cells(Lequ, 7).Cut .Cells(ligne, 7)
                                 ligne = ligne + 1
                        End With
                    End If
                Next
    'supprime les lignes si la premiere celulle est vide
    
        Application.ScreenUpdating = False
        Application.DisplayAlerts = False
        .Activate
        .[a65000].End(xlUp).Select
      
        Do
            If IsEmpty(ActiveCell) Then
            ActiveCell.EntireRow.Delete
            End If
            ActiveCell.Offset(-1, 0).Select
            Loop Until ActiveCell.Row = 1
            Application.ScreenUpdating = True
            Application.DisplayAlerts = True
        End With
        
     'supprime les lignes si la premiere celulle de la feuille PEA est vide
    
        With Sheets("PEA")
        Application.ScreenUpdating = False
        Application.DisplayAlerts = False
        .Activate
        .[a65000].End(xlUp).Select
        
    
        Do
            If IsEmpty(ActiveCell) Then
            ActiveCell.EntireRow.Delete
            End If
            ActiveCell.Offset(-1, 0).Select
            Loop Until ActiveCell.Row = 1
            Application.ScreenUpdating = True
            Application.DisplayAlerts = True
            
        ' masque les lignes avec r
        For LignR = .Range("A65536").End(xlUp).Row To 5 Step -1
        If .Cells(LignR, 5) = "r" Then .Rows(LignR).Hidden = True
        Next
        End With
        
    ElseIf Sheets("Equilibrage").Cells(1, 1) = "Visa Laurence" Then
       With Sheets("Equilibrage")
            Range("Tableau112").Select
                Selection.Borders(xlDiagonalDown).LineStyle = xlNone
                Selection.Borders(xlDiagonalUp).LineStyle = xlNone
                Selection.Borders(xlEdgeLeft).LineStyle = xlNone
                Selection.Borders(xlEdgeTop).LineStyle = xlNone
                Selection.Borders(xlEdgeBottom).LineStyle = xlNone
                Selection.Borders(xlEdgeRight).LineStyle = xlNone
                Selection.Borders(xlInsideVertical).LineStyle = xlNone
                Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
                    With Selection.Interior
                        .Pattern = xlNone
                        .TintAndShade = 0
                        .PatternTintAndShade = 0
                    End With
                For Lequ = 6 To .[a65000].End(xlUp).Row
                    If .Cells(Lequ, 5) = "p" Then
                        With Sheets("Visa Laurence")
                                ligne = .[a65000].End(xlUp).Row + 1
                                 Sheets("Equilibrage").Cells(Lequ, 1).Cut .Cells(ligne, 1)
                                 Sheets("Equilibrage").Cells(Lequ, 2).Cut .Cells(ligne, 2)
                                 Sheets("Equilibrage").Cells(Lequ, 3).Cut .Cells(ligne, 3)
                                 Sheets("Equilibrage").Cells(Lequ, 4).Cut .Cells(ligne, 4)
                                 Sheets("Equilibrage").Cells(Lequ, 5).Cut .Cells(ligne, 5)
                                 Sheets("Equilibrage").Cells(Lequ, 6).Cut .Cells(ligne, 6)
                                 Sheets("Equilibrage").Cells(Lequ, 7).Cut .Cells(ligne, 7)
                                 ligne = ligne + 1
                                
                        End With
                    ElseIf .Cells(Lequ, 5) = "" Then
                        With Sheets("Visa Laurence")
                                  ligne = .[a65000].End(xlUp).Row + 1
                                 Sheets("Equilibrage").Cells(Lequ, 1).Cut .Cells(ligne, 1)
                                 Sheets("Equilibrage").Cells(Lequ, 2).Cut .Cells(ligne, 2)
                                 Sheets("Equilibrage").Cells(Lequ, 3).Cut .Cells(ligne, 3)
                                 Sheets("Equilibrage").Cells(Lequ, 4).Cut .Cells(ligne, 4)
                                 Sheets("Equilibrage").Cells(Lequ, 5).Cut .Cells(ligne, 5)
                                 Sheets("Equilibrage").Cells(Lequ, 6).Cut .Cells(ligne, 6)
                                 Sheets("Equilibrage").Cells(Lequ, 7).Cut .Cells(ligne, 7)
                                 ligne = ligne + 1
                        End With
                    ElseIf .Cells(Lequ, 5) = "r" Then
                        With Sheets("Visa Laurence")
                                  ligne = .[a65000].End(xlUp).Row + 1
                                 Sheets("Equilibrage").Cells(Lequ, 1).Cut .Cells(ligne, 1)
                                 Sheets("Equilibrage").Cells(Lequ, 2).Cut .Cells(ligne, 2)
                                 Sheets("Equilibrage").Cells(Lequ, 3).Cut .Cells(ligne, 3)
                                 Sheets("Equilibrage").Cells(Lequ, 4).Cut .Cells(ligne, 4)
                                 Sheets("Equilibrage").Cells(Lequ, 5).Cut .Cells(ligne, 5)
                                 Sheets("Equilibrage").Cells(Lequ, 6).Cut .Cells(ligne, 6)
                                 Sheets("Equilibrage").Cells(Lequ, 7).Cut .Cells(ligne, 7)
                                 ligne = ligne + 1
                        End With
                    End If
                Next
    'supprime les lignes si la premiere celulle est vide
    
        Application.ScreenUpdating = False
        Application.DisplayAlerts = False
        .Activate
        .[a65000].End(xlUp).Select
      
        Do
            If IsEmpty(ActiveCell) Then
            ActiveCell.EntireRow.Delete
            End If
            ActiveCell.Offset(-1, 0).Select
            Loop Until ActiveCell.Row = 1
            Application.ScreenUpdating = True
            Application.DisplayAlerts = True
        End With
        
     'supprime les lignes si la premiere celulle de la feuille PEL est vide
    
        With Sheets("Visa Laurence")
        Application.ScreenUpdating = False
        Application.DisplayAlerts = False
        .Activate
        .[a65000].End(xlUp).Select
        
    
        Do
            If IsEmpty(ActiveCell) Then
            ActiveCell.EntireRow.Delete
            End If
            ActiveCell.Offset(-1, 0).Select
            Loop Until ActiveCell.Row = 1
            Application.ScreenUpdating = True
            Application.DisplayAlerts = True
            
        ' masque les lignes avec r
        For LignR = .Range("A65536").End(xlUp).Row To 5 Step -1
        If .Cells(LignR, 5) = "r" Then .Rows(LignR).Hidden = True
        Next
        End With
        
 ElseIf Sheets("Equilibrage").Cells(1, 1) = "Crédit du nord" Then
       With Sheets("Equilibrage")
            Range("Tableau112").Select
                Selection.Borders(xlDiagonalDown).LineStyle = xlNone
                Selection.Borders(xlDiagonalUp).LineStyle = xlNone
                Selection.Borders(xlEdgeLeft).LineStyle = xlNone
                Selection.Borders(xlEdgeTop).LineStyle = xlNone
                Selection.Borders(xlEdgeBottom).LineStyle = xlNone
                Selection.Borders(xlEdgeRight).LineStyle = xlNone
                Selection.Borders(xlInsideVertical).LineStyle = xlNone
                Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
                    With Selection.Interior
                        .Pattern = xlNone
                        .TintAndShade = 0
                        .PatternTintAndShade = 0
                    End With
                For Lequ = 6 To .[a65000].End(xlUp).Row
                    If .Cells(Lequ, 5) = "p" Then
                        With Sheets("Crédit du nord")
                                ligne = .[a65000].End(xlUp).Row + 1
                                 Sheets("Equilibrage").Cells(Lequ, 1).Cut .Cells(ligne, 1)
                                 Sheets("Equilibrage").Cells(Lequ, 2).Cut .Cells(ligne, 2)
                                 Sheets("Equilibrage").Cells(Lequ, 3).Cut .Cells(ligne, 3)
                                 Sheets("Equilibrage").Cells(Lequ, 4).Cut .Cells(ligne, 4)
                                 Sheets("Equilibrage").Cells(Lequ, 5).Cut .Cells(ligne, 5)
                                 Sheets("Equilibrage").Cells(Lequ, 6).Cut .Cells(ligne, 6)
                                 Sheets("Equilibrage").Cells(Lequ, 7).Cut .Cells(ligne, 7)
                                 ligne = ligne + 1
                                
                        End With
                    ElseIf .Cells(Lequ, 5) = "" Then
                        With Sheets("Crédit du nord")
                                  ligne = .[a65000].End(xlUp).Row + 1
                                 Sheets("Equilibrage").Cells(Lequ, 1).Cut .Cells(ligne, 1)
                                 Sheets("Equilibrage").Cells(Lequ, 2).Cut .Cells(ligne, 2)
                                 Sheets("Equilibrage").Cells(Lequ, 3).Cut .Cells(ligne, 3)
                                 Sheets("Equilibrage").Cells(Lequ, 4).Cut .Cells(ligne, 4)
                                 Sheets("Equilibrage").Cells(Lequ, 5).Cut .Cells(ligne, 5)
                                 Sheets("Equilibrage").Cells(Lequ, 6).Cut .Cells(ligne, 6)
                                 Sheets("Equilibrage").Cells(Lequ, 7).Cut .Cells(ligne, 7)
                                 ligne = ligne + 1
                        End With
                    ElseIf .Cells(Lequ, 5) = "r" Then
                        With Sheets("Crédit du nord")
                                  ligne = .[a65000].End(xlUp).Row + 1
                                 Sheets("Equilibrage").Cells(Lequ, 1).Cut .Cells(ligne, 1)
                                 Sheets("Equilibrage").Cells(Lequ, 2).Cut .Cells(ligne, 2)
                                 Sheets("Equilibrage").Cells(Lequ, 3).Cut .Cells(ligne, 3)
                                 Sheets("Equilibrage").Cells(Lequ, 4).Cut .Cells(ligne, 4)
                                 Sheets("Equilibrage").Cells(Lequ, 5).Cut .Cells(ligne, 5)
                                 Sheets("Equilibrage").Cells(Lequ, 6).Cut .Cells(ligne, 6)
                                 Sheets("Equilibrage").Cells(Lequ, 7).Cut .Cells(ligne, 7)
                                 ligne = ligne + 1
                        End With
                    End If
                Next
    'supprime les lignes si la premiere celulle est vide
    
        Application.ScreenUpdating = False
        Application.DisplayAlerts = False
        .Activate
        .[a65000].End(xlUp).Select
      
        Do
            If IsEmpty(ActiveCell) Then
            ActiveCell.EntireRow.Delete
            End If
            ActiveCell.Offset(-1, 0).Select
            Loop Until ActiveCell.Row = 1
            Application.ScreenUpdating = True
            Application.DisplayAlerts = True
        End With
        
     'supprime les lignes si la premiere celulle de la feuille PEL est vide
    
        With Sheets("Crédit du nord")
        Application.ScreenUpdating = False
        Application.DisplayAlerts = False
        .Activate
        .[a65000].End(xlUp).Select
        
    
        Do
            If IsEmpty(ActiveCell) Then
            ActiveCell.EntireRow.Delete
            End If
            ActiveCell.Offset(-1, 0).Select
            Loop Until ActiveCell.Row = 1
            Application.ScreenUpdating = True
            Application.DisplayAlerts = True
            
        ' masque les lignes avec r
        For LignR = .Range("A65536").End(xlUp).Row To 5 Step -1
        If .Cells(LignR, 5) = "r" Then .Rows(LignR).Hidden = True
        Next
        End With
    End If
ElseIf Sheets("Equilibrage").Cells(3, 4) <> "0" Then
FormEquil2.Show
End If
End Sub
 

Dudu2

XLDnaute Barbatruc
Bonjour,
Tu ne pourrais pas réduire la longueur de ce code en créant une fonction avec 2 ou 3 paramètres qui ferait le traitement qui semble répété N fois dans ce code et qui le rend assez indigeste , pour plus de lisibilité ?
 

Discussions similaires

Statistiques des forums

Discussions
311 730
Messages
2 081 991
Membres
101 856
dernier inscrit
Marina40