Réduire un code

bonsoir

voici un petit bout de code qui marche tres bien , existe une facon de pouvoir le reduire ?

Dim DLig As Long
  Sheets("Feuil1").Range("E10").Copy
  With Sheets("Feuil2")
    DLig = .Range("B" & Rows.Count).End(xlUp).Row
    ' Si la dernière ligne remplie est inférieure à 8, alors la dernière ligne est 8
    If DLig < 8 Then DLig = 8
    '
   .Range("B" & DLig + 1).PasteSpecial _
        Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
  End With
  Application.CutCopyMode = False
Selection.Font.ColorIndex = 3

'-----------------------------------------------------------------------------------------------------------
Sheets("Feuil1").Range("E11").Copy
  With Sheets("Feuil2")
    DLig = .Range("C" & Rows.Count).End(xlUp).Row
    ' Si la dernière ligne remplie est inférieure à 8, alors la dernière ligne est 8
   If DLig < 8 Then DLig = 8
    '
   .Range("C" & DLig + 1).PasteSpecial _
        Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
  End With
  Application.CutCopyMode = False
'--------------------------------------------------------------------------------------------------------

  Sheets("Feuil1").Range("E12").Copy
  With Sheets("Feuil2")
    DLig = .Range("D" & Rows.Count).End(xlUp).Row
    ' Si la dernière ligne remplie est inférieure à 8, alors la dernière ligne est 8
   If DLig < 8 Then DLig = 8
    '
   .Range("D" & Lig + 1).PasteSpecial _
        Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
  End With
  Application.CutCopyMode = False
  '-------------------------------------------------------------------------------------
 Sheets("Feuil1").Range("E13").Copy
  With Sheets("Feuil2")
    DLig = .Range("E" & Rows.Count).End(xlUp).Row
    ' Si la dernière ligne remplie est inférieure à 8, alors la dernière ligne est 8
   If DLig < 8 Then DLig = 8
    '
   .Range("E" & DLig + 1).PasteSpecial _
        Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
  End With
  Application.CutCopyMode = False
'---------------------------------------------------------------------------------------
    Sheets("Feuil1").Range("E13").Copy
  With Sheets("Feuil2")
    DLig = .Range("F" & Rows.Count).End(xlUp).Row
    ' Si la dernière ligne remplie est inférieure à 8, alors la dernière ligne est 8
   If DLig < 8 Then DLig = 8
    '
   .Range("F" & DLig + 1).PasteSpecial _
        Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
  End With
  Application.CutCopyMode = False
'-----------------------------------------------------------------------------------------------
  Sheets("Feuil1").Range("E14").Copy
  With Sheets("Feuil2")
    DLig = .Range("G" & Rows.Count).End(xlUp).Row
    ' Si la dernière ligne remplie est inférieure à 8, alors la dernière ligne est 8
   If DLig < 8 Then DLig = 8
    '
   .Range("G" & DLig + 1).PasteSpecial _
        Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
  End With
  Application.CutCopyMode = False
 '-------------------------------------------------------------------------------------------------
   Sheets("Feuil1").Range("E15").Copy
  With Sheets("Feuil2")
    DLig = .Range("H" & Rows.Count).End(xlUp).Row
    ' Si la dernière ligne remplie est inférieure à 8, alors la dernière ligne est 8
   If DLig < 8 Then DLig = 8
    '
   .Range("H" & DLig + 1).PasteSpecial _
        Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
  End With
  Application.CutCopyMode = False
 '-------------------------------------------------------------------------------------------------
 Sheets("Feuil1").Range("E16").Copy
  With Sheets("Feuil2")
    DLig = .Range("I" & Rows.Count).End(xlUp).Row
    ' Si la dernière ligne remplie est inférieure à 8, alors la dernière ligne est 8
   If DLig < 8 Then DLig = 8
    '
   .Range("I" & DLig + 1).PasteSpecial _
        Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
  End With
  Application.CutCopyMode = False

  '----------------------------------------------------------------------------------------------------
 Sheets("Feuil1").Range("E17").Copy
  With Sheets("Feuil2")
    DLig = .Range("J" & Rows.Count).End(xlUp).Row
    ' Si la dernière ligne remplie est inférieure à 8, alors la dernière ligne est 8
   If DLig < 8 Then DLig = 8
    '
   .Range("j" & DLig + 1).PasteSpecial _
        Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
  End With
  Application.CutCopyMode = False

  '----------------------------------------------------------------------------------------------------

End Sub

en vous remerciant

Bonjour,

petit question: est ce que ton Dlig est variable d'une colonne a une autre, et puis ne t’intéresse pas d'avoir le copier coller sur la même ligne

mon Dlig n'est pas variable d'une colonne à l'autre , merci