Autres Macro avec Application union, je coince...

[Christian0258]

Bonjour à tout le forum,
Je souhaiterais votre aide sur cette macro qui doit copier deux zones, contenant des formules, et coller les valeurs sur ces deux mêmes zones.
Je précise que dans mon projet il y aura une douzaine de zones, mais le principe reste le même : copier et coller les valeurs afin d'écraser les formules.

voir fichier

Merci pour votre aide.
Bien amicalement,
Christian

 

[pierrejean]

Bonjour Christian0258
A tester:

 Set r1 = Sheets("ESSAI").Range("A1:B2")
 Set r2 = Sheets("ESSAI").Range("C3:D4")
 Set plageCopie = Union(r1, r2)
 For Each cel In plageCopie
   cel.Value = cel.Value
 Next

 

[Christian0258]

Re, le forum, pierrejean

Merci, pierrejean, pour ton aide, ça fonctionne parfaitement.
Bien à toi,
Christian

 

[Christian0258]

Re, le forum, pierrejean,

Après essais, ça rame, avec un message "excel ne répond plus", puis ça reprend, mais c'est long...
ci-dessous la macro, pourriez-vous me dire...

Sub RemplaceFormuleParValeur()
Application.ScreenUpdating = False
Application.Calculation = xlManual
Dim r1, r2, r3, r4, r5, r6, r7, r8, r9, r10, r11, r12, plageCopie As Range
Dim r13, r14, r15, r16, r17, r18, r19, r20, r21, r22, r23, r24, plageColle As Range

Set r1 = Sheets("RECETTES").Range("J4:AD4")
Set r2 = Sheets("RECETTES").Range("J7:AD7")
Set r3 = Sheets("RECETTES").Range("J10:AD10")
Set r4 = Sheets("RECETTES").Range("J16:AD16")
Set r5 = Sheets("RECETTES").Range("J19:AD19")
Set r6 = Sheets("RECETTES").Range("J22:AD22")
Set r7 = Sheets("RECETTES").Range("J31:AD31")
Set r8 = Sheets("RECETTES").Range("J34:AD34")
Set r9 = Sheets("RECETTES").Range("J37:AD37")
Set r10 = Sheets("RECETTES").Range("J43:AD43")
Set r11 = Sheets("RECETTES").Range("J46:AD46")
Set r12 = Sheets("RECETTES").Range("J49:AD49")

Set plageCopie = Union(r1, r2, r3, r4, r5, r6, r7, r8, r9, r10, r11, r12)
For Each cel In plageCopie
cel.Value = cel.Value
Next

Set r13 = Sheets("RECETTES").Range("J4:AD4")
Set r14 = Sheets("RECETTES").Range("J7:AD7")
Set r15 = Sheets("RECETTES").Range("J10:AD10")
Set r16 = Sheets("RECETTES").Range("J16:AD16")
Set r17 = Sheets("RECETTES").Range("J19:AD19")
Set r18 = Sheets("RECETTES").Range("J22:AD22")
Set r19 = Sheets("RECETTES").Range("J31:AD31")
Set r20 = Sheets("RECETTES").Range("J34:AD34")
Set r21 = Sheets("RECETTES").Range("J37:AD37")
Set r22 = Sheets("RECETTES").Range("J43:AD43")
Set r23 = Sheets("RECETTES").Range("J46:AD46")
Set r24 = Sheets("RECETTES").Range("J49:AD49")

Set plageColle = Union(r13, r14, r15, r16, r17, r18, r19, r20, r21, r22, r23, r24)
For Each cel In plageColle
cel.Value = cel.Value
Next

Application.ScreenUpdating = True
Application.Calculation = xlAutomatic
End Sub

Merci pour votre aide. Christian

 

[eriiic]

Bonjour,

Tu as plutôt intérêt à faire par plages entières plutôt que cellule par cellule, surtout si tes plages sont plus importantes en réalité :

Sheets("ESSAI").Range("A1:B2")=Sheets("ESSAI").Range("A1:B2").value

Et si tu les déclares dans un tableau r() , tu peux le faire par une boucle sur chaque plage :

    Dim r(1 To 2) As Range, i As Long
    Set r(1) = Sheets("ESSAI").Range("A1:B2")
    Set r(2) = Sheets("ESSAI").Range("C3:D4")
    For i = 1 To 2
        r(i).Value = r(i).Value
    Next i

eric

Edit : ah ben ça se confirme

 

[Christian0258]

Re le forum, pierrejean, eriiiic

Merci, eriiiic, pour ton aide, peux-tu me dire comment articuler ce que tu préconises sur ton post.
Me faire un début de macro... que je finirais …?
Bien à toi,
Christian

 

[eriiic]

Ben il y est le début de macro non ?
Elle est même entière...

 

[mapomme]

Bonjour @Christian0258 ,

Et surtout pour saluer @pierrejean et @eriiiic ,

Sub CopieValeur()
Const Plages = "A1:B2,c3:d4,D11:D16,E9:E14"
Dim xPl
   For Each xPl In Split(Plages, ",")
      Sheets("essai").Range(xPl) = Sheets("essai").Range(xPl).Value
   Next xPl
End Sub

 

[eriiic]

Bonjour mapomme,

évidemment, que n'y ai-je point pensé ;-)
eric

 

[Christian0258]

Re, le forum pierrjean, eriiiic, mapomme
Merci pour votre aide. ça fonctionne mais pas la première fois… j'ai erreur" définie par l'application ou l'objet" le débogage pointe la ligne, je réinitialise et après ça fonctionne???.

la macro dans mon fichier ;
Sub RemplaceFormuleParValeurPrixRECETTES()
Const Plages = "J4:AD4,J7:AD7,J10:AD10,J16:AD16,J19:AD19,J22:AD22,J31:AD31,J34:AD34,J37:AD37,J43:AD43,J46:AD46,J49:AD49"
Dim xPl
For Each xPl In Split(Plages, ",")
Sheets("RECETTES").Range(xPl) = Sheets("RECETTES").Range(xPl).Value
Next xPl
End Sub

Merci pour votre aide,
Christian

 

[mapomme]

j'ai erreur" définie par l'application ou l'objet" le débogage pointe la ligne, je réinitialise et après ça fonctionne???

Bizarre, chez moi avec votre code, ça fonctionne.

Sinon quelle ligne est en cause et/ou joignez le fichier qui bogue ?

 

[Christian0258]

Re, mapomme
Merci pour ton aide.
sur cette ligne
Sheets("RECETTES").Range(xPl) = Sheets("RECETTES").Range(xPl).Value

oui c'est vrai, j'ai mis des formules sur le fichier post1 sur toutes les lignes 4, 7, 10, 16 ect ...et ça fonctionne. ???
Bien à toi,
Christian

 

[mapomme]

oui c'est vrai, j'ai mis des formules sur le fichier post1 sur toutes les lignes 4, 7, 10, 16 ect ...et ça fonctionne. ???

Alors là, c'est encore plus étrange...
Sur une feuille vide, sur mon micro, ni cri ni insulte de la part de VBA à l'exécution...
Je suis perplexe

 

[Christian0258]

Re, mapomme
Quand ça plante la première fois, si je clique sur Fin et non Débogage, après je lance la macro et ça marche ???
Effectivement dans le fichier (post1) ça fonctionne parfaitement.
Bien à toi

 

[Christian0258]

Re, le forum,pierrejean, eriiiic, ma pomme

Merci à vous, ça fonctionne...quel c.. c'était un problème de feuille protégée...

Bien à vous, encore un grand merci.
Christian