blocage macro par recalcul

Re : blocage macro par recalcul

Bonjour,

ça serait quand même plus simple avec ton code car celà me parait étrange qu'un calcul s'éxécute s'il n'est pas demandé. Ce ne sont que des lignes de codes qui font ce qu'on leur demande...

Sylvain

Re : blocage macro par recalcul

J'avais prevenu ...
je vais le tronquer pour que ca passe

etape 1:
definition des variables et menages dans les feuilles


Option Explicit

Sub consolidation()


Cells.Select
Selection.RemoveSubtotal

Application.ScreenUpdating = False



Dim c11, c21, c31, c41, c51, c12, c22, c32, c42, c52, c61, c62, c71, c72, c81, c82, c91, c92, c101, c102, c111, c112, c121, c122
Dim feuil1 As String, feuil2 As String, Feuil3 As String, Feuil4 As String, feuil5 As String, Feuil6 As String, feuil7 As String, feuil8 As String, feuil9 As String, feuil10 As String, feuil11 As String

feuil1 = Sheets("Garde").Range("g3").Value
feuil2 = Sheets("Garde").Range("g4").Value
Feuil3 = Sheets("Garde").Range("g5").Value
Feuil4 = Sheets("Garde").Range("g6").Value
feuil5 = Sheets("Garde").Range("g7").Value
Feuil6 = Sheets("Garde").Range("g8").Value
feuil7 = Sheets("Garde").Range("g9").Value
feuil8 = Sheets("Garde").Range("g10").Value
feuil9 = Sheets("Garde").Range("g11").Value
feuil10 = Sheets("Garde").Range("g12").Value
feuil11 = Sheets("Garde").Range("g13").Value





Dim Exist As Byte
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim ws3 As Worksheet
Dim ws4 As Worksheet
Dim ws5 As Worksheet
Dim ws6 As Worksheet
Dim ws7 As Worksheet
Dim ws8 As Worksheet
Dim ws9 As Worksheet
Dim ws10 As Worksheet
Dim ws11 As Worksheet
Dim ws12 As Worksheet


On Error Resume Next

Set ws2 = Sheets("lien")
Set ws1 = Sheets(feuil1)
Set ws3 = Sheets(Feuil3)
Set ws4 = Sheets(Feuil4)
Set ws6 = Sheets(feuil2)
Set ws5 = Sheets(feuil5)
Set ws7 = Sheets(Feuil6)
Set ws8 = Sheets(feuil7)
Set ws9 = Sheets(feuil8)
Set ws10 = Sheets(feuil9)
Set ws11 = Sheets(feuil10)
Set ws12 = Sheets(feuil11)

On Error Resume Next

If ws1 Is Nothing Then Resume Next
c11 = ws1.Range("e65536").End(xlUp).Row
c12 = ws1.Range("F65536").End(xlUp).Row
ws1.Select
Cells.Select
Selection.RemoveSubtotal
Dim i%
For i = c11 To 1 Step -1
If Range("e" & i).Value Like "Somme" & "*" Then Rows(i).Delete
Next i
For i = c12 To 1 Step -1
If Range("g" & i).Value Like "Somme" & "*" Then Rows(i).Delete
Next i
c11 = ws1.Range("e65536").End(xlUp).Row
c12 = ws1.Range("F65536").End(xlUp).Row



If ws2 Is Nothing Then Resume Next
c21 = ws2.Range("A65536").End(xlUp).Row
c22 = ws2.Range("C65536").End(xlUp).Row


If ws3 Is Nothing Then Resume Next
c31 = ws3.Range("e65536").End(xlUp).Row
c32 = ws3.Range("F65536").End(xlUp).Row
ws3.Select
Cells.Select
Selection.RemoveSubtotal
For i = c31 To 1 Step -1
If Range("e" & i).Value Like "Somme" & "*" Then Rows(i).Delete
Next i
For i = c32 To 1 Step -1
If Range("g" & i).Value Like "Somme" & "*" Then Rows(i).Delete
Next i
c31 = ws3.Range("e65536").End(xlUp).Row
c32 = ws3.Range("F65536").End(xlUp).Row

If ws4 Is Nothing Then Resume Next
c41 = ws4.Range("e65536").End(xlUp).Row
c42 = ws4.Range("F65536").End(xlUp).Row
ws4.Select
Cells.Select
Selection.RemoveSubtotal

For i = c41 To 1 Step -1
If Range("e" & i).Value Like "Somme" & "*" Then Rows(i).Delete
Next i
For i = c42 To 1 Step -1
If Range("g" & i).Value Like "Somme" & "*" Then Rows(i).Delete
Next i
c41 = ws4.Range("e65536").End(xlUp).Row
c42 = ws4.Range("F65536").End(xlUp).Row



If ws6 Is Nothing Then Resume Next
c61 = ws6.Range("e65536").End(xlUp).Row
c62 = ws6.Range("F65536").End(xlUp).Row
ws6.Select
Cells.Select
Selection.RemoveSubtotal
For i = c61 To 1 Step -1
If Range("e" & i).Value Like "Somme" & "*" Then Rows(i).Delete
Next i
For i = c62 To 1 Step -1
If Range("g" & i).Value Like "Somme" & "*" Then Rows(i).Delete
Next i
c61 = ws6.Range("e65536").End(xlUp).Row
c62 = ws6.Range("F65536").End(xlUp).Row


If ws5 Is Nothing Then Resume Next
c51 = ws5.Range("e65536").End(xlUp).Row
c52 = ws5.Range("F65536").End(xlUp).Row
ws5.Select
Cells.Select
Selection.RemoveSubtotal
For i = c51 To 1 Step -1
If Range("e" & i).Value Like "Somme" & "*" Then Rows(i).Delete
Next i
For i = c52 To 1 Step -1
If Range("g" & i).Value Like "Somme" & "*" Then Rows(i).Delete
Next i
c51 = ws5.Range("e65536").End(xlUp).Row
c52 = ws5.Range("F65536").End(xlUp).Row


If ws7 Is Nothing Then Resume Next
c71 = ws7.Range("e65536").End(xlUp).Row
c72 = ws7.Range("F65536").End(xlUp).Row
ws7.Select
Cells.Select
Selection.RemoveSubtotal
For i = c71 To 1 Step -1
If Range("e" & i).Value Like "Somme" & "*" Then Rows(i).Delete
Next i
For i = c72 To 1 Step -1
If Range("g" & i).Value Like "Somme" & "*" Then Rows(i).Delete
Next i
c71 = ws7.Range("e65536").End(xlUp).Row
c72 = ws7.Range("F65536").End(xlUp).Row





If ws8 Is Nothing Then Resume Next
c81 = ws8.Range("e65536").End(xlUp).Row
c82 = ws8.Range("F65536").End(xlUp).Row
ws8.Select
Cells.Select
Selection.RemoveSubtotal
For i = c81 To 1 Step -1
If Range("e" & i).Value Like "Somme" & "*" Then Rows(i).Delete
Next i
For i = c82 To 1 Step -1
If Range("g" & i).Value Like "Somme" & "*" Then Rows(i).Delete
Next i
c81 = ws8.Range("e65536").End(xlUp).Row
c82 = ws8.Range("F65536").End(xlUp).Row

If ws9 Is Nothing Then Resume Next
c91 = ws9.Range("e65536").End(xlUp).Row
c92 = ws9.Range("F65536").End(xlUp).Row
ws9.Select
Cells.Select
Selection.RemoveSubtotal
For i = c91 To 1 Step -1
If Range("e" & i).Value Like "Somme" & "*" Then Rows(i).Delete
Next i
For i = c92 To 1 Step -1
If Range("g" & i).Value Like "Somme" & "*" Then Rows(i).Delete
Next i
c91 = ws9.Range("e65536").End(xlUp).Row
c92 = ws9.Range("F65536").End(xlUp).Row


If ws10 Is Nothing Then Resume Next
c101 = ws10.Range("e65536").End(xlUp).Row
c102 = ws10.Range("F65536").End(xlUp).Row
ws10.Select
Cells.Select
Selection.RemoveSubtotal
For i = c101 To 1 Step -1
If Range("e" & i).Value Like "Somme" & "*" Then Rows(i).Delete
Next i
For i = c102 To 1 Step -1
If Range("g" & i).Value Like "Somme" & "*" Then Rows(i).Delete
Next i
c101 = ws10.Range("e65536").End(xlUp).Row
c102 = ws10.Range("F65536").End(xlUp).Row

If ws11 Is Nothing Then Resume Next
c111 = ws11.Range("e65536").End(xlUp).Row
c112 = ws11.Range("F65536").End(xlUp).Row
ws11.Select
Cells.Select
Selection.RemoveSubtotal
For i = c111 To 1 Step -1
If Range("e" & i).Value Like "Somme" & "*" Then Rows(i).Delete
Next i
For i = c112 To 1 Step -1
If Range("g" & i).Value Like "Somme" & "*" Then Rows(i).Delete
Next i
c111 = ws11.Range("e65536").End(xlUp).Row
c112 = ws11.Range("F65536").End(xlUp).Row







If ws12 Is Nothing Then Resume Next
c121 = ws12.Range("e65536").End(xlUp).Row
c122 = ws12.Range("F65536").End(xlUp).Row
ws12.Select
Cells.Select
Selection.RemoveSubtotal
For i = c121 To 1 Step -1
If Range("e" & i).Value Like "Somme" & "*" Then Rows(i).Delete
Next i
For i = c122 To 1 Step -1
If Range("g" & i).Value Like "Somme" & "*" Then Rows(i).Delete
Next i
c121 = ws12.Range("e65536").End(xlUp).Row
c122 = ws12.Range("F65536").End(xlUp).Row


On Error GoTo 0

Re : blocage macro par recalcul

etape 2 on charge les données des feuilles et on en garde le meilleur:

ws2.Visible = True
If ws1 Is Nothing Then GoTo out2

ws2.Select
Range("A:A").Clear
Range("C:C").Clear
ws1.Select

Range("E10:E" & c11).Select
Selection.Copy
ws2.Select
Cells(c21, 1).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
out2:
If ws3 Is Nothing Then GoTo out3
c21 = ws2.Range("A65536").End(xlUp).Row

ws3.Select

Range("E10:E" & c31).Select
Selection.Copy
ws2.Select
Cells(c21 + 1, 1).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False


out3:
If ws4 Is Nothing Then GoTo out4
c21 = ws2.Range("A65536").End(xlUp).Row
ws4.Select

Range("E10:E" & c41).Select
Selection.Copy
ws2.Select
Cells(c21 + 1, 1).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

out4:
If ws5 Is Nothing Then GoTo out5
c21 = ws2.Range("A65536").End(xlUp).Row
ws5.Select

Range("E10:E" & c51).Select
Selection.Copy
ws2.Select
Cells(c21 + 1, 1).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

out5:
If ws6 Is Nothing Then GoTo out51
c21 = ws2.Range("A65536").End(xlUp).Row
ws6.Select

Range("E10:E" & c61).Select
Selection.Copy
ws2.Select
Cells(c21 + 1, 1).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False


out51:
If ws7 Is Nothing Then GoTo out52
c21 = ws2.Range("A65536").End(xlUp).Row
ws7.Select

Range("E10:E" & c71).Select
Selection.Copy
ws2.Select
Cells(c21 + 1, 1).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

out52:
If ws8 Is Nothing Then GoTo out53
c21 = ws2.Range("A65536").End(xlUp).Row
ws8.Select

Range("E10:E" & c81).Select
Selection.Copy
ws2.Select
Cells(c21 + 1, 1).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False


out53:
If ws9 Is Nothing Then GoTo out54
c21 = ws2.Range("A65536").End(xlUp).Row
ws9.Select

Range("E10:E" & c91).Select
Selection.Copy
ws2.Select
Cells(c21 + 1, 1).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False


out54:
If ws10 Is Nothing Then GoTo out56
c21 = ws2.Range("A65536").End(xlUp).Row
ws10.Select

Range("E10:E" & c101).Select
Selection.Copy
ws2.Select
Cells(c21 + 1, 1).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False


out56:
If ws11 Is Nothing Then GoTo out57
c21 = ws2.Range("A65536").End(xlUp).Row
ws11.Select

Range("E10:E" & c111).Select
Selection.Copy
ws2.Select
Cells(c21 + 1, 1).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False


out57:
If ws12 Is Nothing Then GoTo out58
c21 = ws2.Range("A65536").End(xlUp).Row
ws12.Select

Range("E10:E" & c121).Select
Selection.Copy
ws2.Select
Cells(c21 + 1, 1).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False


out58:



If ws1 Is Nothing Then GoTo out6
c22 = ws1.Range("C65536").End(xlUp).Row
ws1.Select
Range("F10:F" & c12).Select
Selection.Copy
ws2.Select
Cells(c22, 3).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False






out6:
If ws3 Is Nothing Then GoTo out7
c22 = ws3.Range("C65536").End(xlUp).Row


ws3.Select
Range("F10:F" & c32).Select
Selection.Copy
ws2.Select
Cells(c22 + 1, 3).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False


out7:
If ws4 Is Nothing Then GoTo out8
c22 = ws2.Range("C65536").End(xlUp).Row
ws4.Select
Range("F10:F" & c42).Select
Selection.Copy
ws2.Select
Cells(c22 + 1, 3).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

out8:
If ws5 Is Nothing Then GoTo out9
c22 = ws2.Range("C65536").End(xlUp).Row
ws5.Select
Range("F10:F" & c52).Select
Selection.Copy
ws2.Select
Cells(c22 + 1, 3).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

out9:
If ws6 Is Nothing Then GoTo out10
c22 = ws2.Range("C65536").End(xlUp).Row
ws6.Select
Range("F10:F" & c62).Select
Selection.Copy
ws2.Select
Cells(c22 + 1, 3).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
out10:




If ws7 Is Nothing Then GoTo out11
c22 = ws2.Range("C65536").End(xlUp).Row
ws7.Select
Range("F10:F" & c72).Select
Selection.Copy
ws2.Select
Cells(c22 + 1, 3).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
out11:

If ws8 Is Nothing Then GoTo out12
c22 = ws2.Range("C65536").End(xlUp).Row
ws8.Select
Range("F10:F" & c82).Select
Selection.Copy
ws2.Select
Cells(c22 + 1, 3).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
out12:

If ws8 Is Nothing Then GoTo out12
c22 = ws2.Range("C65536").End(xlUp).Row
ws8.Select
Range("F10:F" & c82).Select
Selection.Copy
ws2.Select
Cells(c22 + 1, 3).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
out13:
If ws9 Is Nothing Then GoTo out14
c22 = ws2.Range("C65536").End(xlUp).Row
ws9.Select
Range("F10:F" & c92).Select
Selection.Copy
ws2.Select
Cells(c22 + 1, 3).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
out14:
If ws10 Is Nothing Then GoTo out15
c22 = ws2.Range("C65536").End(xlUp).Row
ws10.Select
Range("F10:F" & c102).Select
Selection.Copy
ws2.Select
Cells(c22 + 1, 3).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
out15:
If ws11 Is Nothing Then GoTo out16
c22 = ws2.Range("C65536").End(xlUp).Row
ws11.Select
Range("F10:F" & c112).Select
Selection.Copy
ws2.Select
Cells(c22 + 1, 3).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
out16:
If ws12 Is Nothing Then GoTo out17
c22 = ws2.Range("C65536").End(xlUp).Row
ws12.Select
Range("F10:F" & c122).Select
Selection.Copy
ws2.Select
Cells(c22 + 1, 3).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
out17:






ws2.Select
Range("a:a").Select
Selection.Sort Key1:=Range("a1"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

Range("c:c").Select
Selection.Sort Key1:=Range("c1"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

Range("A1").Select
Do While ActiveCell.Value = ""
Selection.Delete Shift:=xlUp
Loop

Range("C1").Select
Do While ActiveCell.Value = ""
Selection.Delete Shift:=xlUp
Loop


Calculate

Dim n As Integer
Dim lign As Integer
Dim col As Collection

Set col = New Collection
For n = 1 To Range("A65536").End(xlUp).Row
On Error Resume Next
col.Add Range("A" & n), CStr(Range("A" & n))
On Error GoTo 0
Next n
lign = 1
For n = 1 To col.Count
Range("B" & lign) = col(n)
lign = lign + 1
Next n



Set col = New Collection
For n = 1 To Range("C65536").End(xlUp).Row
On Error Resume Next
col.Add Range("C" & n), CStr(Range("C" & n))
On Error GoTo 0
Next n
lign = 1
For n = 1 To col.Count
Range("D" & lign) = col(n)
lign = lign + 1
Next n


Calculate

Re : blocage macro par recalcul

etape 3 on range tous dans une feuille et on met les formules adequates:

ws2.Select
Dim derligne1%, derligne2%
Dim i1%, i2%

derligne1 = Sheets("Conso_Dpt").Range("D65536").End(xlUp).Row
derligne2 = ws2.Range("p65536").End(xlUp).Row
For i2 = 1 To derligne2
For i1 = 14 To derligne1
If Sheets("Conso_Dpt").Range("D" & i1) = ws2.Range("p" & i2) Then
Exist = 1
GoTo Suivant
End If
Next
If Exist = 1 Then GoTo Suivant
Sheets("Conso_Dpt").Range("D" & derligne1 + 1) = ws2.Range("p" & i2)
derligne1 = Sheets("Conso_Dpt").Range("D65536").End(xlUp).Row
Suivant:
Exist = 0
Next

Sheets("Conso_Dpt").Select
Rows(13).Hidden = False

derligne1 = Range("E65536").End(xlUp).Row
derligne2 = Range("D65536").End(xlUp).Row


Range("A13:C13").Copy
Range(Cells(derligne2 + 1, 1), Cells(derligne1 + 1, 5)).Select
ActiveSheet.Paste
Application.CutCopyMode = False



Range("E13:GF13").Copy
Range(Cells(derligne2 + 1, 7), Cells(derligne1 + 1, 188)).Select

ActiveSheet.Paste
Application.CutCopyMode = False

Rows(13).Hidden = True
Sheets("Conso_Dpt").Select

Calculate
Range("A14:GF1000").Select
Selection.Copy
Range("A14:GF1000").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False





Sheets("Conso_Dpt").Select
Range("A14😀O10000").Select
Selection.Sort Key1:=Range("B14"), key2:=Range("E14"), key3:=Range("G14"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom




ws2.Visible = False
Application.ScreenUpdating = True
Sheets("Conso_Dpt").Select

Application.DisplayAlerts = False



Range(Cells(13, 1), Cells(derligne2 + 2, 200)).Select

Selection.Subtotal GroupBy:=2, Function:=xlSum, TotalList:=Array(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, 100, 101, 102, 103, 104, 105, 106, 107, 108, 109, 110, 111, _
112, 113, 114, 115, 116, 117, 118, 119, 120, 121, 122, 123, 124, 125, 126, 127, 128, 129, 130, 131 _
, 132, 133, 134, 135, 136, 137, 138, 139, 140, 141, 142, 143, 144, 145, 146, 147, 148, 149, 150, _
151, 152, 153, 154, 155, 156, 157, 158, 159, 160, 161, 162, 163, 164, 165, 166, 167, 168, 169, 170 _
, 171, 172, 173, 174, 175, 176, 177, 178, 179, 180, 181, 182, 183, 184, 185, 186, 187, 188), _
Replace:=False, PageBreaks:=False, SummaryBelowData:=True

derligne2 = Range("D65536").End(xlUp).Row
Range(Cells(13, 1), Cells(derligne2 + 2, 200)).Select
Selection.Subtotal GroupBy:=5, Function:=xlSum, TotalList:=Array(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, 100, 101, 102, 103, 104, 105, 106, 107, 108, 109, 110, 111, _
112, 113, 114, 115, 116, 117, 118, 119, 120, 121, 122, 123, 124, 125, 126, 127, 128, 129, 130, 131 _
, 132, 133, 134, 135, 136, 137, 138, 139, 140, 141, 142, 143, 144, 145, 146, 147, 148, 149, 150, _
151, 152, 153, 154, 155, 156, 157, 158, 159, 160, 161, 162, 163, 164, 165, 166, 167, 168, 169, 170 _
, 171, 172, 173, 174, 175, 176, 177, 178, 179, 180, 181, 182, 183, 184, 185, 186, 187, 188), _
Replace:=False, PageBreaks:=False, SummaryBelowData:=True

derligne2 = Range("D65536").End(xlUp).Row
Range(Cells(13, 1), Cells(derligne2 + 2, 200)).Select
Selection.Subtotal GroupBy:=7, Function:=xlSum, TotalList:=Array(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, 100, 101, 102, 103, 104, 105, 106, 107, 108, 109, 110, 111, _
112, 113, 114, 115, 116, 117, 118, 119, 120, 121, 122, 123, 124, 125, 126, 127, 128, 129, 130, 131 _
, 132, 133, 134, 135, 136, 137, 138, 139, 140, 141, 142, 143, 144, 145, 146, 147, 148, 149, 150, _
151, 152, 153, 154, 155, 156, 157, 158, 159, 160, 161, 162, 163, 164, 165, 166, 167, 168, 169, 170 _
, 171, 172, 173, 174, 175, 176, 177, 178, 179, 180, 181, 182, 183, 184, 185, 186, 187, 188), _
Replace:=False, PageBreaks:=False, SummaryBelowData:=True

Application.DisplayAlerts = True

End Sub

merci pour ceux qui auront le courage de lire.
et merci à ceux aussi qui ne l'auront pas

Re : blocage macro par recalcul

Millediou, j'ai déja vu des listings de code mais là .......... pfiouuuuuuu

Je crois qu'on commence par un très mauvais bout, Flo
Pourrais tu nous expliquer ce que doit faire tout ce schmilblic avec toutes ces feuilles, le principe de tout cela, quoi

A voir le tout, je suis sur qu'on peut ..achement simplifier, mais faut d'abord comprendre lol

Re : blocage macro par recalcul

le process se passe en plusieur etape:
j'ai des fichiers xls qui sont chargés de données.
Je cherche à faire une consolidation de ces données
donc dans un premier temps dans une autre macro je charge les données en créant les onglets qui vont bien et tout.
Ensuite, je vais sur l'onglet de consolidation.
Je clique sur mon bouton et ca doit,
un definir les variables, c'est à dire les onglets sur les quels on veut travailler et les dernieres lignes. Tant qu'à y etre on nttoie les feuilles qui existe de leur somme et de leur sous totaux.
Ensuite, je charge une base de donnée ou je met toutes les données et je fais le menage dedans. Ensuite, je compare cette essence avec ce qu'il y a dans ma feuille de conso et je rajoute tous ce qui manque. Ensuite, copie des formule pour les coller en fonction du nombre de ligne necessaire. Ainsi je recupere par des somme.si les données de mes feuilles.
Enfin je met en ordre et fait des sous totaux.
J'ai un fichier similaire qui fonctionne, il a juste 4 variables en moins.
Est ec plus claire?

Re : blocage macro par recalcul

apres etude du probleme, le premier blocage est en

If ws3 Is Nothing Then GoTo out3
c21 = ws2.Range("A65536").End(xlUp).Row

ws3.Select

Range("E10:E" & c31).Select
Selection.Copy
ws2.Select
Cells(c21 + 1, 1).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False


out3:

alors que ws3 existe.

donc je ne vois pas ce qu'il ne lui va pas.

merci de toutes lumieres...

Re : blocage macro par recalcul

flo2002 à dit:

apres etude du probleme, le premier blocage est en

If ws3 Is Nothing Then GoTo out3
c21 = ws2.Range("A65536").End(xlUp).Row

ws3.Select

Range("E10:E" & c31).Select
Selection.Copy
ws2.Select
Cells(c21 + 1, 1).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False


out3:

alors que ws3 existe.

donc je ne vois pas ce qu'il ne lui va pas.

merci de toutes lumieres...

Cliquez pour agrandir...

Salut
code du début de post :

feuil1 = Sheets("Garde").Range("g3").Value
feuil2 = Sheets("Garde").Range("g4").Value
Feuil3 = Sheets("Garde").Range("g5").Value
Feuil4 = Sheets("Garde").Range("g6").Value
feuil5 = Sheets("Garde").Range("g7").Value
Feuil6 = Sheets("Garde").Range("g8").Value
feuil7 = Sheets("Garde").Range("g9").Value
feuil8 = Sheets("Garde").Range("g10").Value
feuil9 = Sheets("Garde").Range("g11").Value
feuil10 = Sheets("Garde").Range("g12").Value
feuil11 = Sheets("Garde").Range("g13").Value





Dim Exist As Byte
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim ws3 As Worksheet
Dim ws4 As Worksheet
Dim ws5 As Worksheet
Dim ws6 As Worksheet
Dim ws7 As Worksheet
Dim ws8 As Worksheet
Dim ws9 As Worksheet
Dim ws10 As Worksheet
Dim ws11 As Worksheet
Dim ws12 As Worksheet


On Error Resume Next

Set ws2 = Sheets("lien")
Set ws1 = Sheets(feuil1)
Set ws3 = Sheets(Feuil3)
Set ws4 = Sheets(Feuil4)
Set ws6 = Sheets(feuil2)
Set ws5 = Sheets(feuil5)
Set ws7 = Sheets(Feuil6)
Set ws8 = Sheets(feuil7)
Set ws9 = Sheets(feuil8)
Set ws10 = Sheets(feuil9)
Set ws11 = Sheets(feuil10)
Set ws12 = Sheets(feuil11)

On Error Resume Next

Cliquez pour agrandir...

Pour moi On Error Resume Next signifie : m'en fout des erreurs. donc pas la peine de répéter.
Si Excel a essayé de te signaler qu'il coinçait sur une définition, tu ne veux pas en entendre parler. Par contre t'es sû qu'il n'y en a pas.
Je sais, je suis un dinosaure, mais je gère toujours mes erreurs, même si c'est pour dire qu'elle n'est pas importante. Et sur les grandes macros, les petites erreurs insignifiantes...
sur ton bout de code qui buggue, fais un ws3.name pour vérifier si il existe.

Re : blocage macro par recalcul

En faite les erreurs sont normales car le nombre de feuille peut varier. j'ai donc des feuilles appellées "".
Ensuite lors de ma macro je fais bien attention à "sauter" les feuilles qui me pose probleme.
Merci comme meme.
cette fois ci ca a coincé un peu plus loins, j'avance....doucement