Bonjour,

Votre macro est parfaite cependant elle est un peu trop lourde lorsqu'on l'applique à plusieurs cellules engendrant le ralentissement de l'ordinateur

Auriez-vous moyen de simplifier ou d'alléger ce code ? 

Sub Report()

Application.ScreenUpdating = False

    Sheets("calcul-MEX").Select

    With Range("A2:P2000")

        .ClearContents

    End With

Application.ScreenUpdating = False

Dim WsS As Worksheet, WsC As Worksheet, WsD As Worksheet

Dim j As Integer, i As Integer

        Set WsS = Worksheets("ENTREES")

        Set WsC = Worksheets("calcul-MEX")

        Set WsD = Worksheets("D-Projet")

'cells(j:ligne, colonne)

    For j = 1 To WsS.Range("Z" & Rows.Count).End(xlUp).Row

        For i = 1 To WsS.Cells(j, 26).Value

            WsS.Cells(j, 1).Copy Destination:=WsC.Range("A" & WsC.Range("A" & Rows.Count).End(xlUp).Row + 1)

            WsS.Cells(j, 2).Copy Destination:=WsC.Range("B" & WsC.Range("B" & Rows.Count).End(xlUp).Row + 1)

            WsS.Cells(j, 3).Copy Destination:=WsC.Range("C" & WsC.Range("C" & Rows.Count).End(xlUp).Row + 1)

            WsS.Cells(j, 4).Copy Destination:=WsC.Range("D" & WsC.Range("D" & Rows.Count).End(xlUp).Row + 1)

            WsS.Cells(j, 5).Copy Destination:=WsC.Range("E" & WsC.Range("E" & Rows.Count).End(xlUp).Row + 1)

            WsS.Cells(j, 6).Copy Destination:=WsC.Range("F" & WsC.Range("F" & Rows.Count).End(xlUp).Row + 1)

            WsS.Cells(j, 7).Copy Destination:=WsC.Range("G" & WsC.Range("G" & Rows.Count).End(xlUp).Row + 1)

            WsS.Cells(j, 8).Copy Destination:=WsC.Range("H" & WsC.Range("H" & Rows.Count).End(xlUp).Row + 1)

            WsS.Cells(j, 9).Copy Destination:=WsC.Range("I" & WsC.Range("I" & Rows.Count).End(xlUp).Row + 1)

            WsS.Cells(j, 10).Copy Destination:=WsC.Range("J" & WsC.Range("J" & Rows.Count).End(xlUp).Row + 1)

            WsS.Cells(j, 11).Copy Destination:=WsC.Range("K" & WsC.Range("K" & Rows.Count).End(xlUp).Row + 1)

            WsS.Cells(j, 12).Copy Destination:=WsC.Range("L" & WsC.Range("L" & Rows.Count).End(xlUp).Row + 1)

            WsS.Cells(j, 13).Copy Destination:=WsC.Range("M" & WsC.Range("M" & Rows.Count).End(xlUp).Row + 1)

            WsS.Cells(j, 14).Copy Destination:=WsC.Range("N" & WsC.Range("N" & Rows.Count).End(xlUp).Row + 1)

            WsS.Cells(j, 15).Copy Destination:=WsC.Range("O" & WsC.Range("O" & Rows.Count).End(xlUp).Row + 1)

            WsS.Cells(j, 16).Copy Destination:=WsC.Range("P" & WsC.Range("P" & Rows.Count).End(xlUp).Row + 1)

            Application.CutCopyMode = False 'On vide le presse-papier

        Next i

    Next j

    Set WsC = Nothing: Set WsS = Nothing: Set WsD = Nothing

    Worksheets("RAPPORT").Activate

End Sub

Je vous remercie par avance et vous souhaite une agréable soirée