Remplacer des formules par VBA

Créer une discussion
Répondre
  • Initiateur de la discussion Initiateur de la discussion Aloha
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
A

Aloha

XLDnaute Accro
Bonjour,

Pour chaque personne dans une liste je calcule une feuille avec plein de valeurs, puis je copie les valeurs personne par personne dans un autre classeur.
Etant donné qu'il y a beaucoup de formules c'est assez lent.
Comment devrais-je procéder pour remplacer les formules par du code VBA pour accélérer les opérations?

Merci pour tout tuyau.

Aloha
 
Trier par date Trier par votes
Re : Remplacer des formules par VBA

Bonjour,

Ci-attachée la feuille contenant les formules qui doivent toutes être mises à jour lorsque le nom de la personne change. Avec ces formules je récupère les données principalement dans une feuille appelée "Database", à l'intérieur d'un classeur "Base".

Je copie et colle les fiches, nom par nom, dans un nouveau classeur, en y collant les valeurs, formats et largeurs de colonnes.

Ci-dessous le code.

Je sais qu'il ne faut pas faire comme cela: répéter le code 17 fois pour 17 fiches, mais je ne sais pas comment faire autrement, et cela fonctionne!

Ce qui m'embête c'est la mise à jour de cette multitude de formules.

Les noms sont contenus dans les feuilles des services et je les copie dans ma "Fiche individuelle". Ce qui manque aussi, c'est transformer le code de telle façon à ce qu'il tienne compte du fait que la longeur de la liste des noms est variable. Pour l'instant il y a 17 personnes dans le Service1, mais cela peut changer et je dois donc, dans mon code, ajouter le code pour une fiche, resp. enlever une fiche.

Bonne journée

Aloha


Code: 
Sub Fiches_individuelles_Service1()
'
    Sheets("Service1").Select
    Range("B1:R1").Select
    Selection.Copy
    Sheets("Fiche individuelle 6 périodes").Select
    Range("S3").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    Application.CutCopyMode = False
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Sort Key1:=Range("S3"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    Sheets("Switch").Select
    Range("K1").Select
    ActiveCell.FormulaR1C1 = "Service1"
    Sheets("Fiche individuelle 6 périodes").Select
    Workbooks.Add
    Sheets.Add
    Sheets.Add
    Sheets.Add
    Sheets.Add
    Sheets.Add
    Sheets.Add
    Sheets.Add
    Sheets.Add
    Sheets.Add
    Sheets.Add
    Sheets.Add
    Sheets.Add
    Sheets.Add
    Sheets.Add

    Sheets.Add
    ActiveWorkbook.SaveAs Filename:= _
        "C:\Documents and Settings\Administrateur\Bureau\Heures 2009\Récolte des fiches\Service1\Fiches individuelles Service1.xls" _
        , FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
        
'1. fiche
    Windows("Base.xls").Activate
    Range("P3").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=RC[3]"
    Range("B1:P66").Select
    Selection.Copy
    Windows("Fiches individuelles Service1.xls").Activate
    Sheets("Feuil17").Select
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    ActiveSheet.Name = Range("O3").Value
    ActiveSheet.PageSetup.PrintArea = "$A$1:$O$66"
    Application.ExecuteExcel4Macro "PAGE.SETUP(,,0.7,0.2,0.2,0.2,,,TRUE,TRUE,1,9,true,,,,,0.2,0.2,FALSE,FALSE)"
    
'2. fiche
    Windows("Base.xls").Activate
    Range("P3").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=R[1]C[3]"
    Range("B1:P66").Select
    Selection.Copy
    Windows("Fiches individuelles Service1.xls").Activate
    Sheets("Feuil16").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    ActiveSheet.Name = Range("O3").Value
    ActiveSheet.PageSetup.PrintArea = "$A$1:$O$66"
    Application.ExecuteExcel4Macro "PAGE.SETUP(,,0.7,0.2,0.2,0.2,,,TRUE,TRUE,1,9,true,,,,,0.2,0.2,FALSE,FALSE)"
'3. fiche
    Windows("Base.xls").Activate
    Range("P3").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=R[2]C[3]"
    Range("B1:P66").Select
    Selection.Copy
    Windows("Fiches individuelles Service1.xls").Activate
    Sheets("Feuil15").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    ActiveSheet.Name = Range("O3").Value
    ActiveSheet.PageSetup.PrintArea = "$A$1:$O$66"
    Application.ExecuteExcel4Macro "PAGE.SETUP(,,0.7,0.2,0.2,0.2,,,TRUE,TRUE,1,9,true,,,,,0.2,0.2,FALSE,FALSE)"
'4. fiche
    Windows("Base.xls").Activate
    Range("P3").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=R[3]C[3]"
    Range("B1:P66").Select
    Selection.Copy
    Windows("Fiches individuelles Service1.xls").Activate
    Sheets("Feuil14").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    ActiveSheet.Name = Range("O3").Value
    ActiveSheet.PageSetup.PrintArea = "$A$1:$O$66"
    Application.ExecuteExcel4Macro "PAGE.SETUP(,,0.7,0.2,0.2,0.2,,,TRUE,TRUE,1,9,true,,,,,0.2,0.2,FALSE,FALSE)"
'5. fiche
    Windows("Base.xls").Activate
    Range("P3").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=R[4]C[3]"
    Range("B1:P66").Select
    Selection.Copy
    Windows("Fiches individuelles Service1.xls").Activate
    Sheets("Feuil13").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    ActiveSheet.Name = Range("O3").Value
    ActiveSheet.PageSetup.PrintArea = "$A$1:$O$66"
    Application.ExecuteExcel4Macro "PAGE.SETUP(,,0.7,0.2,0.2,0.2,,,TRUE,TRUE,1,9,true,,,,,0.2,0.2,FALSE,FALSE)"
    
'6. fiche
    Windows("Base.xls").Activate
    Range("P3").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=R[5]C[3]"
    Range("B1:P66").Select
    Selection.Copy
    Windows("Fiches individuelles Service1.xls").Activate
    Sheets("Feuil12").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    ActiveSheet.Name = Range("O3").Value
    ActiveSheet.PageSetup.PrintArea = "$A$1:$O$66"
    Application.ExecuteExcel4Macro "PAGE.SETUP(,,0.7,0.2,0.2,0.2,,,TRUE,TRUE,1,9,true,,,,,0.2,0.2,FALSE,FALSE)"
        
'7. fiche
    Windows("Base.xls").Activate
    Range("P3").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=R[6]C[3]"
    Range("B1:P66").Select
    Selection.Copy
    Windows("Fiches individuelles Service1.xls").Activate
    Sheets("Feuil11").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    ActiveSheet.Name = Range("O3").Value
    ActiveSheet.PageSetup.PrintArea = "$A$1:$O$66"
    Application.ExecuteExcel4Macro "PAGE.SETUP(,,0.7,0.2,0.2,0.2,,,TRUE,TRUE,1,9,true,,,,,0.2,0.2,FALSE,FALSE)"
        
'8. fiche
    Windows("Base.xls").Activate
    Range("P3").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=R[7]C[3]"
    Range("B1:P66").Select
    Selection.Copy
    Windows("Fiches individuelles Service1.xls").Activate
    Sheets("Feuil10").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    ActiveSheet.Name = Range("O3").Value
    ActiveSheet.PageSetup.PrintArea = "$A$1:$O$66"
    Application.ExecuteExcel4Macro "PAGE.SETUP(,,0.7,0.2,0.2,0.2,,,TRUE,TRUE,1,9,true,,,,,0.2,0.2,FALSE,FALSE)"
        
'9. fiche
    Windows("Base.xls").Activate
    Range("P3").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=R[8]C[3]"
    Range("B1:P66").Select
    Selection.Copy
    Windows("Fiches individuelles Service1.xls").Activate
    Sheets("Feuil9").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    ActiveSheet.Name = Range("O3").Value
    ActiveSheet.PageSetup.PrintArea = "$A$1:$O$66"
    Application.ExecuteExcel4Macro "PAGE.SETUP(,,0.7,0.2,0.2,0.2,,,TRUE,TRUE,1,9,true,,,,,0.2,0.2,FALSE,FALSE)"
    
'10. fiche
    Windows("Base.xls").Activate
    Range("P3").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=R[9]C[3]"
    Range("B1:P66").Select
    Selection.Copy
    Windows("Fiches individuelles Service1.xls").Activate
    Sheets("Feuil8").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    ActiveSheet.Name = Range("O3").Value
    ActiveSheet.PageSetup.PrintArea = "$A$1:$O$66"
    Application.ExecuteExcel4Macro "PAGE.SETUP(,,0.7,0.2,0.2,0.2,,,TRUE,TRUE,1,9,true,,,,,0.2,0.2,FALSE,FALSE)"
    
    '11. fiche
    Windows("Base.xls").Activate
    Range("P3").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=R[10]C[3]"
    Range("B1:P66").Select
    Selection.Copy
    Windows("Fiches individuelles Service1.xls").Activate
    Sheets("Feuil7").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    ActiveSheet.Name = Range("O3").Value
    ActiveSheet.PageSetup.PrintArea = "$A$1:$O$66"
    Application.ExecuteExcel4Macro "PAGE.SETUP(,,0.7,0.2,0.2,0.2,,,TRUE,TRUE,1,9,true,,,,,0.2,0.2,FALSE,FALSE)"

    '12. fiche
    Windows("Base.xls").Activate
    Range("P3").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=R[11]C[3]"
    Range("B1:P66").Select
    Selection.Copy
    Windows("Fiches individuelles Service1.xls").Activate
    Sheets("Feuil6").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    ActiveSheet.Name = Range("O3").Value
    ActiveSheet.PageSetup.PrintArea = "$A$1:$O$66"
    Application.ExecuteExcel4Macro "PAGE.SETUP(,,0.7,0.2,0.2,0.2,,,TRUE,TRUE,1,9,true,,,,,0.2,0.2,FALSE,FALSE)"
    
'13. fiche
    Windows("Base.xls").Activate
    Range("P3").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=R[12]C[3]"
    Range("B1:P66").Select
    Selection.Copy
    Windows("Fiches individuelles Service1.xls").Activate
    Sheets("Feuil5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    ActiveSheet.Name = Range("O3").Value
    ActiveSheet.PageSetup.PrintArea = "$A$1:$O$66"
    Application.ExecuteExcel4Macro "PAGE.SETUP(,,0.7,0.2,0.2,0.2,,,TRUE,TRUE,1,9,true,,,,,0.2,0.2,FALSE,FALSE)"

'14. fiche
    Windows("Base.xls").Activate
    Range("P3").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=R[13]C[3]"
    Range("B1:P66").Select
    Selection.Copy
    Windows("Fiches individuelles Service1.xls").Activate
    Sheets("Feuil4").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    ActiveSheet.Name = Range("O3").Value
    ActiveSheet.PageSetup.PrintArea = "$A$1:$O$66"
    Application.ExecuteExcel4Macro "PAGE.SETUP(,,0.7,0.2,0.2,0.2,,,TRUE,TRUE,1,9,true,,,,,0.2,0.2,FALSE,FALSE)"

'15. fiche
    Windows("Base.xls").Activate
    Range("P3").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=R[14]C[3]"
    Range("B1:P66").Select
    Selection.Copy
    Windows("Fiches individuelles Service1.xls").Activate
    Sheets("Feuil1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    ActiveSheet.Name = Range("O3").Value
    ActiveSheet.PageSetup.PrintArea = "$A$1:$O$66"
    Application.ExecuteExcel4Macro "PAGE.SETUP(,,0.7,0.2,0.2,0.2,,,TRUE,TRUE,1,9,true,,,,,0.2,0.2,FALSE,FALSE)"

'16. fiche
    Windows("Base.xls").Activate
    Range("P3").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=R[15]C[3]"
    Range("B1:P66").Select
    Selection.Copy
    Windows("Fiches individuelles Service1.xls").Activate
    Sheets("Feuil2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    ActiveSheet.Name = Range("O3").Value
    ActiveSheet.PageSetup.PrintArea = "$A$1:$O$66"
    Application.ExecuteExcel4Macro "PAGE.SETUP(,,0.7,0.2,0.2,0.2,,,TRUE,TRUE,1,9,true,,,,,0.2,0.2,FALSE,FALSE)"
    
'17. fiche
    Windows("Base.xls").Activate
    Range("P3").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=R[16]C[3]"
    Range("B1:P66").Select
    Selection.Copy
    Windows("Fiches individuelles Service1.xls").Activate
    Sheets("Feuil3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    ActiveSheet.Name = Range("O3").Value
    ActiveSheet.PageSetup.PrintArea = "$A$1:$O$66"
    Application.ExecuteExcel4Macro "PAGE.SETUP(,,0.7,0.2,0.2,0.2,,,TRUE,TRUE,1,9,true,,,,,0.2,0.2,FALSE,FALSE)

     Windows("Base.xls").Activate
     Sheets("Fiche individuelle 6 périodes").Select
Range("S3:S20").Select
    Selection.Clear

End Sub
 

Pièces jointes

Dernière édition:
Vote positif 0 Vote négatif
Re : Remplacer des formules par VBA

Bonjour

Aloha
Stp, Tu peux cliquer sur ce bouton dans ton message
edit.gif

et puis sur ce bouton
code.gif
(en ayant au préalable sélectionner tout le code VBA content dans ton message)

Ce qui aura cet effet sur le code VBA
Code: 
Sub Fiches_individuelles_Service1()
'
    Sheets("Service1").Select
    Range("B1:R1").Select
    Selection.Copy
    Sheets("Fiche individuelle 6 périodes").Select
Comme cela ton message sera plus facile à lire. 😉

Merci
 
Dernière édition:
Vote positif 0 Vote négatif
Re : Remplacer des formules par VBA

Bonjour le fil 🙂,
Entièrement d'accord Stapple 😉!
Bon, le début de ton code un peu nettoyé
Code: 
Application.ScreenUpdating = False
Dim I As Integer
Sub Fiches_individuelles_Service1()
Sheets("Service1").Range("B1:R1").Copy
Sheets("Fiche individuelle 6 périodes").Range("S3").PasteSpecial _
    Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=True
Application.CutCopyMode = False
With Sheets("Service1").Range("B1:R1")
    .HorizontalAlignment = xlGeneral
    .VerticalAlignment = xlBottom
    .WrapText = False
    .Orientation = 0
    .AddIndent = False
    .IndentLevel = 0
    .ShrinkToFit = False
    .ReadingOrder = xlContext
    .MergeCells = False
    .Sort Key1:=Range("S3"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
End With
Sheets("Switch").Range("K1").FormulaR1C1 = "Service1"
Sheets("Fiche individuelle 6 périodes").Select
Workbooks.Add
For I = 1 To 15
Sheets.Add
Next I
ActiveWorkbook.SaveAs Filename:= _
    "C:\Documents and Settings\Administrateur\Bureau\Heures 2009\Récolte des fiches" _
        & "\Service1\Fiches individuelles Service1.xls" _
        , FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
Application.ScreenUpdating = True
Bon WE 😎
 
Vote positif 0 Vote négatif
Re : Remplacer des formules par VBA

Re, bonjour JNP

Aloha
Tu peux aussi faire comme cela

Ton code sans formatage
Sub Macro1()
MsgBox Date
End Sub

Avec l'emploi des balises BB CODE (sans espace ou est écrit ici [iciCODE] et [ici/CODE] )
[ CODE]
Sub Macro1()
MsgBox Date
End Sub
[ /CODE]

donne ce résultat

Code: 
Sub Macro1()
MsgBox Date
End Sub
 
Dernière édition:
Vote positif 0 Vote négatif
Re : Remplacer des formules par VBA

Bonjour Aloha, JM, JNP, le fil,

Si tu passes par Réponse rapide, en bas à droite, tu n'as pas ce bouton.

Si tu passes par Ajouter une réponse, en bas à gauche,, je crois qu'il y est....

Perso, j'utilise toujours réponse rapide....

Bon après-midi.

Jean-Pierre
 
Vote positif 0 Vote négatif
Re : Remplacer des formules par VBA

Re 🙂,
Et la suite pourrait ressembler à ça
Code: 
Windows("Base.xls").Activate
For I = 1 To 17
Select Case I
Case 17
Range("P3").FormulaR1C1 = "=RC[3]"
Case 16
Range("P3").FormulaR1C1 = "=R[1]C[3]"
Case 15
Range("P3").FormulaR1C1 = "=R[2]C[3]"
Case 14
Range("P3").FormulaR1C1 = "=R[3]C[3]"
Case 13
Range("P3").FormulaR1C1 = "=R[4]C[3]"
Case 12
Range("P3").FormulaR1C1 = "=R[5]C[3]"
Case 11
Range("P3").FormulaR1C1 = "=R[6]C[3]"
Case 10
Range("P3").FormulaR1C1 = "=R[7]C[3]"
Case 9
Range("P3").FormulaR1C1 = "=R[8]C[3]"
Case 8
Range("P3").FormulaR1C1 = "=R[9]C[3]"
Case 7
Range("P3").FormulaR1C1 = "=R[10]C[3]"
Case 6
Range("P3").FormulaR1C1 = "=RC[3]"
Case 5
Range("P3").FormulaR1C1 = "=RC[3]"
Case 4
Range("P3").FormulaR1C1 = "=RC[3]"
Case 3
Range("P3").FormulaR1C1 = "=RC[3]"
Case 2
Range("P3").FormulaR1C1 = "=RC[3]"
Case 1
Range("P3").FormulaR1C1 = "=RC[3]"
End Select
Range("B1:P66").Copy
Windows("Fiches individuelles Service1.xls").Activate
With Sheets("Feuil" & I).Range("A1")
    .PasteSpecial Paste:=xlPasteValues, _
        Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    .PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    .PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
End With
Sheets("Feuil" & I).PageSetup.PrintArea = "$A$1:$O$66"
Sheets("Feuil" & I).Name = Range("O3").Value
Application.ExecuteExcel4Macro "PAGE.SETUP(,,0.7,0.2,0.2,0.2,,,TRUE,TRUE,1,9,true ,,,,,0.2,0.2,FALSE,FALSE)"
Next I
A vérifier, et j'ai pas mis tous les cas pour P3.
Bon WE 😎
 
Vote positif 0 Vote négatif
Re : Remplacer des formules par VBA

Re, bonjour jeanpierre


Je vous livre une astuce que je viens de tester pour ajouter 15 feuilles

Code: 
Sub Macro1()
With Application
    .SheetsInNewWorkbook = 15
        Workbooks.Add
    .SheetsInNewWorkbook = 3
End With
End Sub

Ce qui remplace ceci dans le code d'Aloha (modifié par JNP 😉 )
Code: 
Workbooks.Add
For I = 1 To 15
Sheets.Add
Next I
 
Vote positif 0 Vote négatif
Re : Remplacer des formules par VBA

Bonjour,

Merci pour vos suggestions et propositions.

Ce qui y manque e.a. ce serait une routine qui rendrait la liste des noms, ici Range("B1:R1").Select, flexible en ce qui concerne sa longeur.
Idem pour le nombre de feuilles à créer, puisqu'il faut une feuille par nom.

A+

Aloha
 
Vote positif 0 Vote négatif
Re : Remplacer des formules par VBA

Re


Il n'est pas 2 fois plus long car il y un With/End With

mais pour te faire plaisir, je l'enlève 😉
Code: 
Application.SheetsInNewWorkbook = 15
Workbooks.Add
Application..SheetsInNewWorkbook = 3

Donc nous disons 3 lignes contre 4 lignes pour JNP

Nah 😀 (quoique l'avoir plus longue ca peut mener loin 😛 )
 
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

M
  • Question Question
Microsoft 365 Remplacer une chaine de caractère d'un code VBA par un autre code VBA
2
Réponses
18
Affichages
1 K
patricktoulon
patricktoulon
D
  • Résolu(e)
Microsoft 365 Macro VBA pour copier des feuilles particulières
2
Réponses
21
Affichages
1 K
driss Kor
D
G
  • Question Question
XL 2016 Calcul en boucle de valeurs cibles
Réponses
6
Affichages
408
job75
job75
N
  • Question Question
Microsoft 365 Propagation de formule dans un tableau avec des valeurs existantes (saisies manuellement)
Réponses
4
Affichages
402
NikonvsWild
N
Eric 888
  • Question Question
Microsoft 365 Excel VBA: manipuler des fichiers partagés via Teams / Sharepoint
Réponses
2
Affichages
133
Eric 888
Eric 888
patricktoulon
  • Résolu(e)
XL 2013 remplacer par des vbcrlf les ":" sous condition
Réponses
11
Affichages
494
patricktoulon
patricktoulon
jeff1494
  • Résolu(e)
XL 2021 Une aide pour optimiser du code VBA
2
Réponses
16
Affichages
707
jeff1494
jeff1494
C
  • Question Question
Microsoft 365 macro copie de feuilles (avec formules à adapter)
Réponses
9
Affichages
507
caseras
C
D
  • Question Question
Microsoft 365 Mise à jour des références / liens depuis un sharepoint
Réponses
3
Affichages
684
Dégé59
D
M
  • Question Question
Power Query Fusion Power Query
Réponses
1
Affichages
236
Cousinhub
Cousinhub
M
  • Question Question
XL 2019 Transposer des données d'une feuille vers une autre sous forme de synthèse
Réponses
8
Affichages
762
mromain
mromain
M
  • Question Question
XL 2021 Fichier de suivi avec liens et formules
Réponses
4
Affichages
505
Mily74
M
B
  • Question Question
XL 2019 Conserver les formules qui sont enregistrées dans des cellules
Réponses
8
Affichages
606
Phil69970
Phil69970
A
  • Question Question
XL 2010 Problème ou alternative à SOMPRODUCT en VBA
Réponses
14
Affichages
845
bruno lemaire
B
Poulet13
  • Question Question
XL 2021 EXTRAIRE + SOMME des 6 meilleures valeurs avec condition par participant
Réponses
11
Affichages
500
Poulet13
Poulet13
A
  • Question Question
XL 2021 extraire des informations de plusieurs fichiers
Réponses
4
Affichages
391
job75
job75
R
  • Question Question
XL 2010 Copie de plusieurs plages de cellules spécifiques dans le presse-papier
2
Réponses
20
Affichages
940
Dranreb
Dranreb
A
  • Résolu(e)
XL 2019 VBA newbie
4 5 6
Réponses
80
Affichages
4 K
apocalypse
A
S
  • Résolu(e)
XL 2010 tableau de cumul automatisé
Réponses
13
Affichages
776
stefiskool
S
B
  • Question Question
XL 2016 Somme automatique des prix associés aux produits sélectionnés sur Excel
Réponses
6
Affichages
374
bkarima1
B
Retour