Reduction de code

[tactic6]

Bonjour le forum
toujours à la recherche de code plus simple quelqu'un pourrait me dire si il est possible de réduire ce code de recopie de données ?

Sub N°2()

   Application.ScreenUpdating = False
   With Sheets("Modele")
     
      Sheets("SAISIE").Range("I5").Copy
      .Range("I5").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
         :=False, Transpose:=False
      Sheets("SAISIE").Range("G6").Copy
      .Range("G6").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
         :=False, Transpose:=False
      Sheets("SAISIE").Range("J6").Copy
      .Range("J6").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
         :=False, Transpose:=False
      Sheets("SAISIE").Range("G8").Copy
      .Range("G8").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
         :=False, Transpose:=False
      Sheets("SAISIE").Range("H9").Copy
      .Range("H9").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
         :=False, Transpose:=False
      Sheets("SAISIE").Range("G10").Copy
      .Range("G10").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
         :=False, Transpose:=False
      Sheets("SAISIE").Range("H12").Copy
      .Range("H12").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
         :=False, Transpose:=False
      Sheets("SAISIE").Range("C12").Copy
      .Range("C12").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
         :=False, Transpose:=False
      Sheets("SAISIE").Range("B15:K52").Copy
      .Range("B15:K52").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
         :=False, Transpose:=False
      Sheets("SAISIE").Range("B55:B57").Copy
      .Range("B55:B57").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
         :=False, Transpose:=False
      Sheets("SAISIE").Range("C55:C57").Copy
      .Range("C55:C57").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
         :=False, Transpose:=False
      Sheets("SAISIE").Range("J54:J59").Copy
      .Range("J54:J59").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
         :=False, Transpose:=False
      Sheets("SAISIE").Range("B64").Copy
      .Range("B64").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
         :=False, Transpose:=False
      Sheets("SAISIE").Range("E64").Copy
      .Range("E64").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
         :=False, Transpose:=False
   End With
Application.ScreenUpdating = True
End Sub

le but de ce code est de recopier uniquement les valeurs sans les formules d'une feuille vers une autre

Merci pour vos conseils et TRES bonnes fêtes à tous

 

[sigismond]

Re : Reduction de code

Bonjour à tous et à toi tactic6

Une direction de recherche :

Ton code recopie par collage spécial des champs d'une feuille dans l'autre selon la séquence :

• Sélection feuille source
• Copier
• Sélection feuille cible
• Collage spécial

en faisant une sélection multiple de tous les champs source
et une sélection multiple de tous les champs cible il n'y aurait qu'une itération

Pour faire une sélection multiple, regarde dans l'aide VBA sous collection Range la méthode Union.

Dis nous si tu a réussi à améliorer ton code.

Sigismond

 

[CBernardT]

Re : Reduction de code

Bonjour à tous,

Une macro qui ne fonctionne que si les cellules sources et cibles des deux feuilles ont les mêmes adresses :

Sub Report()
Dim ZoneS As Range, CellS As Range
Set ZoneS = Sheets("SAISIE").Range("I5,G6,J6,G8,H9,G10,H12,C12,B15:B52,B55:B57,C55:C57,J54:J59,B64,D64")
For Each CellS In ZoneS
Sheets("Modele").Range(CellS.Address) = CellS.Value
Next CellS
End Sub

 

[tactic6]

Re : Reduction de code

Merci à tous les deux
@ sigismond merci pour la piste mais ce n'est pas encore dans mes cordes (pas encore...mais je m'y applique)
@ CBernardT c'est parfait ça réduit considérablement les lignes

Grâce à vous tous mon fichier fait un sacré régime

Bonnes Fêtes