Compiler plusieurs onglets en VBA

'Declaration des variables
Dim Sv As String, Ev As String
Dim DerniereLigne As Integer
Dim PremiereLigneVide As Integer
Dim SvPds As Integer, SvObj As Integer
Dim h As Integer, b As Integer, n As Integer
Dim F As Worksheet, NbBoucles As Integer, DEST As Worksheet


Sub EffaceDonnees()
Worksheets("Export pour repartition segment").Visible = True
Worksheets("Export pour repartition segment").Select
Rows("2:1000000").Clear
Range("a2").Select

End Sub

Sub Consolidation()

Load Message
Message.Show vbModeless
Message.Repaint

With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
End With
EffaceDonnees

'Variables
'===========
h = 8 'Premiere ligne à copier
b = 67  'Derniere ligne à copier
n = b - h ' Nombre de lignes à copier
'==========================================================
'==========================================================

For Each F In Sheets
    If F.Name Like "Répartition EV*" Then
  
        SvPds = 9 'Numero de colonne du 1er PDS
      '  SvObj = SvPds + 6 'Numéro de colonne du 1er Objectif
        NbBoucles = F.Range("f1").Value ' Nb de Ptf de l'équipe traitée

                
        For SvPds = 9 To ((NbBoucles * 7) + 2) Step 7
         Set DEST = Worksheets("Export pour repartition segment")
        DerniereLigne = DEST.Cells(Rows.Count, 1).End(xlUp).Row + 1

                    'Copie famille
                    
                    Range(F.Cells(h, 3), F.Cells(b, 3)).Copy
                        ExpoRepSeg.Cells(DerniereLigne, 2).PasteSpecial _
                            Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                    
                    'Copie PTF
                    
                    Sv = F.Cells(2, SvPds).Copy
                    ExpoRepSeg.Range("A" & DerniereLigne & ":A" & DerniereLigne + n).PasteSpecial xlPasteValues
                    
                    'Copie PDS
                    
                    Range(F.Cells(h, SvPds), F.Cells(b, SvPds)).Copy
                    ExpoRepSeg.Range("D" & DerniereLigne).PasteSpecial _
                        Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                       
                    'Copie Objectif
                     
                    Range(F.Cells(h, SvPds + 6), F.Cells(b, SvPds + 6)).Copy
                    ExpoRepSeg.Range("C" & DerniereLigne).PasteSpecial _
                        Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            Next SvPds
  
  
        End If
Next

 ExpoRepSeg.Rows(DerniereLigne + n + 1 & ":1000000").Select
    Selection.Delete Shift:=xlUp
    
With Application
    .CutCopyMode = False
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
End With
Sheets("Export pour repartition segment").Visible = False
Sheets("Répartition Segment").Activate
Msgbox ("La mise à jour est terminée")
Unload Message

    End Sub