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
95
96
97
98
99
| Sub Macro20()
Dim Fe1 As Worksheet
Dim FeA As Worksheet
Dim Plg As Range
' Application.ScreenUpdating = False
Set Fe1 = Sheets("1")
Set FeA = Sheets("A")
For i = 1 To 2
decal = 14 * i
With Fe1
Dim shtFrom As Worksheet, shtTo As Worksheet
Set shtTo = Worksheets("1")
Set shtFrom = Worksheets("A")
shtTo.Range("a20:n79").Value = shtFrom.Range("f20:s79").Offset(0, decal).Value
'copie de la plage issue de la feuille A
' Set Plg = FeA.[F20:S79].Offset(0, decal)
' .[A20].Resize(Plg.Rows.Count, Plg.Columns.Count) = Plg
TestABCD Fe1
'ici copie de plage sur la même feuille (feuille 1), est-ce bon ?
Set shtTo = Worksheets("1")
Set shtFrom = Worksheets("1")
shtTo.Range("bx20:bx79").Offset(0, i).Value = shtFrom.Range("ba20:ba79").Value
shtTo.Range("by1:cl1").Offset(i - 1, 0).Value = shtFrom.Range("be17:br17").Value
'Set Plg = .[BA20:BA79]
'.[BX20].Offset(0, i).Resize(Plg.Rows.Count, Plg.Columns.Count) = Plg
'Set Plg = .[BE17:BR17]
'.[BY1].Offset(i - 1, 0).Resize(Plg.Rows.Count, Plg.Columns.Count) = Plg
End With
Next i
' Application.ScreenUpdating = True
End Sub
Sub TestABCD(Fe As Worksheet)
Dim Tbl(1 To 2, 1 To 14) As String
Dim A As Long, X As Integer, Str_Val_1 As String, Cel As Range
'initialise le début de la formule et de la 1ère cellule
Tbl(1, 1) = "=RC[-1]+SIN(RC[-52]/R"
Tbl(2, 1) = "BE1"
'construit les formules et récupère les adresses des cellules
For X = 2 To 14
Tbl(1, X) = Tbl(1, X - 1) & "17C" & 55 + X & ")+SIN(RC[-" & 53 - X & "]/R"
Tbl(2, X) = Left(Columns(56 + X).Address(0, 0), InStr(Columns(56 + X).Address(0, 0), ":") - 1) & "1"
Next X
'particularité de la 7ème formule (2*SIN)
Tbl(1, 7) = Left(Tbl(1, 7), InStr(Tbl(1, 7), "SIN(RC[-46]/R") - 1) & "2*SIN(RC[-46]/R"
'mets le calcul en manuel afin d'accélérer la proc
Application.Calculation = xlCalculationManual
For X = 1 To 14
For A = 20 To 29
With Fe
'ici la formule en BA20 est écrasée par la suivante ???
.Range("BA20").FormulaR1C1 = Tbl(1, X) & A & "C56)"
.Range("BA20").AutoFill Destination:=.Range("BA20:BA79"), Type:=xlFillDefault
Set Cel = .Range(Tbl(2, X))
Cel.Offset(A - 1, 0) = .Range("BA12")
End With
Next A
Next X
'remets en calcul auto et force le recalcul
Application.Calculation = xlCalculationAutomatic
Application.Calculate
End Sub |
