Copie Collé Formules dans une région

**RastaBomboclat** · 23/05/2016, 21h15

Bonsoir la communauté.

Mon Problème:
J’allimente une tableau excel a partir d’un formulaire qui fonction tres bien. Mais apres ladite alimentation de la feuille excel, il y a des colonnes (qui n’auraient pas dû etre affectées) qui perdent leur formule. J’ai pu ecrire 2 codes qui fonctionne +/- bien mais qui rende l’execution lente. La 1ère est une boucle et la 2ème rempli des cellules qui ne devraient pas encore etre rempli(et ça prend de l’espace inutilement). J'ai appris ici dans ce forum que les Tableaux sont 1000 fois mieux que les boubles For Next. Mais je ne maitrise pas encore la methode de tableau. Mon souci ici c'est que le code soit rapide, mais aussi qu'il ne dépasse pas la limite de la dernière ligne. Ce que fait bien le premier code mais tres lentement.

1º Code: Il marche mais comme une tortue. Je préfererai un TGV.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
Option Explicit
 
Public Sub RecopieFormule01()
Application.ScreenUpdating = False
 
Dim i0 As Integer: Dim i1 As Integer: Dim i2 As Integer: Dim i3 As Integer: Dim i4 As Integer
Dim j As Integer
Dim Cpt As Integer
Cpt = Application.CountA(Sheets("Sheet1").Range("b:b")) + 1
 
'=================================================
    For i0 = 8 To Cpt
    For j = 14 To 15
Sheets("Sheet1").Select
    Range("N1").Select
    Selection.Copy
        Cells(i0, j).Select
            Selection.PasteSpecial Paste:=xlPasteFormulas, _
                Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            Application.CutCopyMode = False
    Next j
    Next i0
'=================================================
    For i1 = 8 To Cpt
Sheets("Sheet1").Select
    Range("S1").Select
    Selection.Copy
        Cells(i1, 19).Select
            Selection.PasteSpecial Paste:=xlPasteFormulas, _
                Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            Application.CutCopyMode = False
    Next i1
'=================================================
    For i2 = 8 To Cpt
Sheets("Sheet1").Select
    Range("T1").Select
    Selection.Copy
        Cells(i2, 20).Select
            Selection.PasteSpecial Paste:=xlPasteFormulas, _
                Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            Application.CutCopyMode = False
    Next i2
'=================================================
    For i3 = 8 To Cpt
Sheets("Sheet1").Select
    Range("AA1").Select
    Selection.Copy
        Cells(i3, 27).Select
            Selection.PasteSpecial Paste:=xlPasteFormulas, _
                Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            Application.CutCopyMode = False
    Next i3
'=================================================
    For i4 = 8 To Cpt
Sheets("Sheet1").Select
    Range("AB1").Select
    Selection.Copy
        Cells(i4, 28).Select
            Selection.PasteSpecial Paste:=xlPasteFormulas, _
                Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            Application.CutCopyMode = False
    Next i4
'=================================================
Application.ScreenUpdating = True
End Sub

2º Code: Pour que ce code ne recopie pas les formules jusqu'à la derniere ligne d'excel 2013 (1048579), je suis obligé de mettre des "1" a chaque colonne où le copie/collé est effectué (N1000 par exemple) et chaque semaine comme un administrateur, devoir descendre plus bas, au fur et a mesure que qu'il y a des ligne de données inserées.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
Sub RecopieFormule()  'Copie la formule se trouvant en ligne "1" et la colle sur toutes les cellules de la même colonne du même tableau.
Application.ScreenUpdating = False
 
Sheets("Sheet1").Select
    Sheets("Sheet1").Range("N1:O1").Select
    Selection.Copy
    Sheets("Sheet1").Range("N8").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
'
Sheets("Sheet1").Select
    Sheets("Sheet1").Range("R1:T1").Select
    Selection.Copy
    Sheets("Sheet1").Range("R8").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
'
Sheets("Sheet1").Select
    Sheets("Sheet1").Range("AA1:AB1").Select
    Selection.Copy
    Sheets("Sheet1").Range("AA8").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
 
Application.ScreenUpdating = True
End Sub

Merci de pouvoir me trouver le code qui pourra accelerer le copie/collé des formules sur ma feuille. En effet plus il y aura des données, plus le nombre de cellules où coller dans une colonne sera élévé.

**joe.levrai** · 23/05/2016, 21h35

Bonjour,

pourquoi vouloir mettre une rustine pour rétablir des formules perdues dans une précédente procédure ?

ne vaudrait-il pas mieux s'intéresser à la procédure qui alimente initialement le tableau ?

A défaut, l'enregistreur de macro va t'aider à trouver la bonne voie :

1) saisir la formule en ligne 1
2) double cliquer dans le coin bas-droit de la cellule pour recopier la formule sur l'ensemble de la colonne utilisée (Autofill)
3) si besoin, modifier le paramètre de recopie s'il ne correspond pas à ce que tu souhaites

avec ça, tu pourras aisément écrire une procédure générique, dotée d'un argument "Numero de Colonne" et d'un argument "Feuille" afin de pouvoir l'appeler quand bon te semble.

Autre méthode : utiliser un tableau structuré, si la première ligne d'une colonne (d'un champs) contient une formule, elle va automatiquement se "propager" sur l'ensemble des lignes

**RastaBomboclat** · 23/05/2016, 21h58

Merci joe.levrai

J'ai deja essayé cette methode mais c'est encore plus lent. Ci-dessous le code que j'avais utilisé, à partir du generateur de macro.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
Option Explicit
Private O As Worksheet, F As Worksheet 'déclare la variable O et F (Onglet)
Private DL01 'déclare la variable DL01(Dernière Ligne)
 
Sub Submit()
Application.ScreenUpdating = False
'Traitement du transfert des données du frm_InvoiceEntries sur la feuille Excel
 
Dim PL As Variant
Dim NF1, NF2, NF3, NF4, NF5, NF6, NF7, NF8, NF9, NF10, NF11, NF12, NF15, NF16, NF18, NF21, NF22, NF28, NF29
Set F = Sheets("Sheet1") 'définit la Feuil F
DL01 = F.Cells(Application.Rows.Count, 2).End(xlUp).Row 'définit la dernière ligne éditée DL01 de la colonne 2 (=B) de l'onglet F
'
'Transpose les données du formulaire sur la feuille Sheet1
            DL01 = DL01 + 1 'redéfinit la dernière ligne DL01
            Set PL = F.Range("B8:B" & DL01) 'redéfinit la plage PL
            NF1 = frm_InvoiceEntries.cbox_Supplier.Value 'définit l'objet dans lequel se trouve la donnée à transferer sur la feuille
            F.Cells(DL01, 2).Value = NF1 'place le nom dans la cellule ligne DL01, colonne 2 de l'onglet F Sheet1
            '''
            DL01 = DL01
            Set PL = F.Range("C8:C" & DL01) 'redéfinit la plage PL
            NF2 = frm_InvoiceEntries.txt_InvoiceNum.Value 'définit l'objet dans lequel se trouve la donnée à transferer sur la feuille
            F.Cells(DL01, 3).Value = NF2 'place le nom dans la cellule ligne DL01, colonne 3 de l'onglet F Sheet1
            '''
Set F = Nothing
ActiveWorkbook.Save
Application.ScreenUpdating = True
End Sub

Sauf qu'avec cette méthode qui m'a fait arracher le cheveux tout le weekend

, il faut specifier à quelle ligne il faut s'arrêter "Destination:=".Moi jusque là, je n'arrive pas a mettre une variable dans la destination, telle que le compteur qui se trouve dans le 1ºCode "Cpt" qui stock le nombre de ligne actuelle du tableau

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
    Range("N8:O8").Select
    Selection.AutoFill Destination:=Range("N8:O29")
    Range("N8:O29").Select

Comme tu as dis, à partir de la procedure qui alimente le tableau. J'y ai pensé, mais je n'ai pas encore trouver la bonne formule (le code qui marche).
Parce que il me met la ma formule comme si c'était un texte fixe. Voici une partie du code dans le formulaire qui allimente le tableau. il ne me resteplus qu'a trouver comment mettre ecrire que dans la cellule:
paste formula:= "=IF(R1="Paid";"-";E1+30)" et que la cellule ayant récu cette formule l'applique en la calculant.

**joe.levrai** · 23/05/2016, 22h20

Euh, juste avec une seule ligne de code .... ça va pas être facile de t'aider sur la procédure initiale.
Elle n'a pas l'air complète en plus ?

Tu parles de temps de traitement long, mais comment veux-tu gagner du temps si à la base tu réalises une procédure qui vient corriger une autre procédure ? C'est de la perte de temps totale

**RastaBomboclat** · 25/05/2016, 11h58

Bonjour la communauté.

Après plusieurs tâtonnements et essais, j’ai pu finalement trouver le code que je cherchais. Je vais le partager avec vous, et tout le monde pourra l’utiliser en l’adaptant à ses besoins.

Le code ci-dessous est au niveau Module. On lui fera appelle par une procédure d’un formulaire pour transférer les données dudit formulaire sur la feuille Excel.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
Option Explicit
Private F As Worksheet 'déclare la variable F (Onglet)
Private DL01 'déclare la variable DL01(Dernière Ligne)
 
Sub Submit()
Application.ScreenUpdating = False
'Traitement du transfert des données du frm_Invoice sur la feuille Excel
 
Dim PL As Variant
Dim NF1, NF2, NF3, NF4, NF5, NF6, NF7, NF8
Set F = Sheets("Sheet1") 'définit la Feuil "Sheet1" en tant que "F"
DL01 = F.Cells(Application.Rows.Count, 2).End(xlUp).Row 'définit la dernière ligne éditée DL01 de la colonne 2 (=B) de l'onglet F
'
'Transpose les données du formulaire sur la feuille Sheet1
 
            DL01 = DL01 + 1 'redéfinit la dernière ligne DL01
            Set PL = F.Range("B8:B" & DL01) 'redéfinit la plage PL
            NF1 = frm_InvoiceEntries.cbox_Supplier.Value 'définit l'objet dans lequel se trouve la donnée à transferer sur la feuille
            F.Cells(DL01, 2).Value = NF1 'place le nom dans la cellule ligne DL01, colonne 2 de l'onglet F Sheet1
            '''
            DL01 = DL01
            Set PL = F.Range("C8:C" & DL01) 'redéfinit la plage PL
            NF2 = frm_InvoiceEntries.txt_InvoiceNum.Value 'définit l'objet dans lequel se trouve la donnée à transferer sur la feuille
            F.Cells(DL01, 3).Value = NF2 'place le nom dans la cellule ligne DL01, colonne 3 de l'onglet F Sheet1
            '''
            '===Colonne contenant une formule excel sans rélation avec le formulaire===
            DL01 = DL01 '+ 1 'redéfinit la dernière ligne DL01
            Set PL = F.Range("N8:N" & DL01)  'redéfinit la plage PL
            F.Cells(DL01, 14).FormulaR1C1 = "=RC[-10]"  'DL01 = Dernière ligne du tableau; 14 = Colonne 14 = Colonne N
            '''
            DL01 = DL01 '+ 1 'redéfinit la dernière ligne DL01
            Set PL = F.Range("O8:O" & DL01)  'redéfinit la plage PL
            F.Cells(DL01, 15).FormulaR1C1 = "=RC[-11]"  'DL01 = Dernière ligne du tableau; 15 = Colonne 15 = Colonne O
            '''
            '===Colonne contenant une formule excel sans rélation avec le formulaire===
            DL01 = DL01 '+ 1 'redéfinit la dernière ligne DL01
            Set PL = F.Range("P8:P" & DL01) 'redéfinit la plage PL
            NF3 = frm_InvoiceEntries.cbox_Currency.Value 'définit l'objet dans lequel se trouve la donnée à transferer sur la feuille
            F.Cells(DL01, 16).Value = NF3 'place le nom dans la cellule ligne DL01, colonne 16 de l'onglet F Sheet1 = Colonne R
            '''
            DL01 = DL01 '+ 1 'redéfinit la dernière ligne DL01
            Set PL = F.Range("Q8:Q" & DL01) 'redéfinit la plage PL
            NF4 = frm_InvoiceEntries.txt_InvoiceAmount.Value 'définit l'objet dans lequel se trouve la donnée à transferer sur la feuille
            F.Cells(DL01, 17).Value = NF4 'place le nom dans la cellule ligne DL01, colonne 17 de l'onglet F Sheet1
            '''
            '===Colonne contenant une formule excel sans rélation avec le formulaire===
            DL01 = DL01 '+ 1 'redéfinit la dernière ligne DL01
            Set PL = F.Range("R8:R" & DL01)  'redéfinit la plage PL
            F.Cells(DL01, 18).FormulaR1C1 = "To be paid"  'DL01 = Dernière ligne du tableau; 18 = Colonne 18 = Colonne R
            '''
            '===Colonne contenant une formule excel sans rélation avec le formulaire===
            DL01 = DL01 '+ 1 'redéfinit la dernière ligne DL01
            Set PL = F.Range("S8:S" & DL01)  'redéfinit la plage PL
            F.Cells(DL01, 19).FormulaR1C1 = "=IF(RC[-1]=""Pago"",""-"",RC[-14]+30)"  'DL01 = Dernière ligne du tableau; 19 = Colonne 19 = Colonne S
            '''
            '===Colonne contenant une formule excel sans rélation avec le formulaire===
            DL01 = DL01 '+ 1 'redéfinit la dernière ligne DL01
            Set PL = F.Range("T8:T" & DL01)  'redéfinit la plage PL
            F.Cells(DL01, 20).FormulaR1C1 = "=IF(RC[-2]=""Pago"",0,IF((TODAY())<RC[-1],0,(TODAY())-RC[-1]))"  'DL01 = Dernière ligne du tableau; 20 = Colonne 20 = Colonne T
            '''
            DL01 = DL01 '+ 1 'redéfinit la dernière ligne DL01
            Set PL = F.Range("V8:V" & DL01) 'redéfinit la plage PL
            NF5 = frm_InvoiceEntries.cbox_Approval.Value 'définit l'objet dans lequel se trouve la donnée à transferer sur la feuille
            F.Cells(DL01, 22).Value = NF5 'place le nom dans la cellule ligne DL01, colonne 22 de l'onglet F Sheet1 = Colonne V
            '''
            DL01 = DL01 '+ 1 'redéfinit la dernière ligne DL01
            Set PL = F.Range("W8:W" & DL01) 'redéfinit la plage PL
            NF6 = frm_InvoiceEntries.txt_StatusProgress.Value 'définit l'objet dans lequel se trouve la donnée à transferer sur la feuille
            F.Cells(DL01, 23).Value = NF6 'place le nom dans la cellule ligne DL01, colonne 23 de l'onglet F Sheet1 = Colonne W
            '''
            '===Colonne contenant une formule excel sans rélation avec le formulaire===
             DL01 = DL01 '+ 1 'redéfinit la dernière ligne DL01
            Set PL = F.Range("AA8:AA" & DL01)  'redéfinit la plage PL
            F.Cells(DL01, 27).FormulaR1C1 = "=IF(OR(RC[-9]="""",RC[-9]=""Por pagar""),IF(RC[-7]<1,""Will be due"",IF(RC[-7]<8,""Due"",""Overdue"")),""Paid"")"  'DL01 = Dernière ligne du tableau; 27 = Colonne 27 = Colonne AA
            '''
            '===Colonne contenant une formule excel sans rélation avec le formulaire===
            DL01 = DL01 '+ 1 'redéfinit la dernière ligne DL01
            Set PL = F.Range("AB8:AB" & DL01)  'redéfinit la plage PL
            F.Cells(DL01, 28).FormulaR1C1 = "=IF(RC[-10]=""Pago"",0,IF((TODAY())<RC[-9],0,(TODAY())-R[-12]C[-9]))"  'DL01 = Dernière ligne du tableau; 28 = Colonne 28 = Colonne AB
            '''
            DL01 = DL01 '+ 1 'redéfinit la dernière ligne DL01
            Set PL = F.Range("AC8:AC" & DL01) 'redéfinit la plage PL
            NF7 = frm_InvoiceEntries.lbl_UserName.Caption 'définit l'objet dans lequel se trouve la donnée à transferer sur la feuille
            F.Cells(DL01, 29).Value = NF7 'place le nom dans la cellule ligne DL01, colonne 29 de l'onglet F Sheet1 = Colonne AC
            '''
            DL01 = DL01 '+ 1 'redéfinit la dernière ligne DL01
            Set PL = F.Range("AD8:AD" & DL01) 'redéfinit la plage PL
            NF8 = frm_InvoiceEntries.lbl_DateUpdate.Caption 'définit l'objet dans lequel se trouve la donnée à transferer sur la feuille
            F.Cells(DL01, 30).Value = NF8 'place le nom dans la cellule ligne DL01, colonne 30 de l'onglet F Sheet1
 
Set F = Nothing
ActiveWorkbook.Save
Application.ScreenUpdating = True
End Sub

Merci de mettre un

si vous aimez.

Copie Collé Formules dans une région

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager