BOUCLE pour alléger le code

BIL boud · 4 Avril 2019

Bonjour

jai creer ce code qui est a mon avis répétitif, est il possible de mettre une boucle pour eviter cela

merci

VB:

Sub essai_qpdc()
Dim a As String



a = Worksheets("NEW_VB_config").Range("o" & 2) '1feuil
b = Worksheets("NEW_VB_config").Range("o" & 3) '2feuil
c = Worksheets("NEW_VB_config").Range("o" & 4) '3feuil
d = Worksheets("NEW_VB_config").Range("o" & 5) '4feuil
E = Worksheets("NEW_VB_config").Range("o" & 6) '5feuil
f = Worksheets("NEW_VB_config").Range("o" & 7) '6feuil
g = Worksheets("NEW_VB_config").Range("o" & 8) '7feuil
h = Worksheets("NEW_VB_config").Range("o" & 9) '8feuil
i = Worksheets("NEW_VB_config").Range("o" & 10) '9feuil
j = Worksheets("NEW_VB_config").Range("o" & 11) '10feuil
k = Worksheets("NEW_VB_config").Range("o" & 12) '11feuil




For i = 2 To 10000

'1 er feuil
If Worksheets("NEW_VB_config").Range("o" & 2) <> "" Then
'a = Worksheets("NEW_VB_config").Range("o" & 2)

If Worksheets(a).Range("n" & i) <> "" Then

x = Left(Worksheets(a).Range("n" & i), 1)
y = Left(Worksheets(a).Range("n" & i), 2)
y1 = Right(y, 1)
y2 = Left(Worksheets(a).Range("n" & i), 3)
y22 = Right(y2, 1)
y3 = Right(Worksheets(a).Range("n" & i), 1)

    If Worksheets(a).Range("a" & i) = Range("a1") Then

          If x = 1 Then
             Range("aa" & i) = x
             Range("w2") = Application.sum(Range("aa2:aa10000"))
             ElseIf x = 2 Then
             Range("ab" & i) = x
             Range("w3") = Application.sum(Range("ab2:ab10000")) / 2
             ElseIf x = 3 Then
             Range("ac" & i) = x
             Range("w4") = Application.sum(Range("ac2:ac10000")) / 3
             ElseIf x = 4 Then
             Range("ad" & i) = x
             Range("w5") = Application.sum(Range("ad2:ad10000")) / 4
             End If
            
             If y1 = 1 Then
             Range("ae" & i) = y1
             Range("x2") = Application.sum(Range("ae2:ae10000"))
             ElseIf y1 = 2 Then
             Range("af" & i) = y1
             Range("x3") = Application.sum(Range("af2:af10000")) / 2
             ElseIf y1 = 3 Then
             Range("ag" & i) = y1
             Range("x4") = Application.sum(Range("ag2:ag10000")) / 3
             ElseIf y1 = 4 Then
             Range("ah" & i) = y1
             Range("x5") = Application.sum(Range("ah2:ah10000")) / 4
             End If
            
            
             If y22 = 1 Then
             Range("ai" & i) = y22
             Range("y2") = Application.sum(Range("ai2:ai10000"))
             ElseIf y22 = 2 Then
             Range("aj" & i) = y22
             Range("y3") = Application.sum(Range("aj2:aj10000")) / 2
             ElseIf y22 = 3 Then
             Range("ak" & i) = y22
             Range("y4") = Application.sum(Range("ak2:ak10000")) / 3
             ElseIf y22 = 4 Then
             Range("al" & i) = y22
             Range("y5") = Application.sum(Range("al2:al10000")) / 4
             End If
            
             If y3 = 1 Then
             Range("am" & i) = y3
             Range("z2") = Application.sum(Range("am2:am10000"))
             ElseIf y3 = 2 Then
             Range("an" & i) = y3
             Range("z3") = Application.sum(Range("an2:an10000")) / 2
             ElseIf y3 = 3 Then
             Range("ao" & i) = y3
             Range("z4") = Application.sum(Range("ao2:ao10000")) / 3
             ElseIf y3 = 4 Then
             Range("ap" & i) = y3
             Range("z5") = Application.sum(Range("ap2:ap10000")) / 4
             End If
            
     End If
End If
End If

' 2 eme feuille

If Worksheets("NEW_VB_config").Range("o" & 3) <> "" Then
'b = Worksheets("NEW_VB_config").Range("o" & 3)
If Worksheets(b).Range("n" & i) <> "" Then

x = Left(Worksheets(b).Range("n" & i), 1)
y = Left(Worksheets(b).Range("n" & i), 2)
y1 = Right(y, 1)
y2 = Left(Worksheets(b).Range("n" & i), 3)
y22 = Right(y2, 1)
y3 = Right(Worksheets(b).Range("n" & i), 1)

    If Worksheets(b).Range("a" & i) = Range("a1") Then

          If x = 1 Then
             Range("aq" & i) = x
             Range("w6") = Application.sum(Range("aq2:aq10000"))
             ElseIf x = 2 Then
             Range("ar" & i) = x
             Range("w7") = Application.sum(Range("ar2:ar10000")) / 2
             ElseIf x = 3 Then
             Range("as" & i) = x
             Range("w8") = Application.sum(Range("as2:as10000")) / 3
             ElseIf x = 4 Then
             Range("at" & i) = x
             Range("w9") = Application.sum(Range("at2:at10000")) / 4
             End If
            
             If y1 = 1 Then
             Range("au" & i) = y1
             Range("x6") = Application.sum(Range("au2:au10000"))
             ElseIf y1 = 2 Then
             Range("av" & i) = y1
             Range("x7") = Application.sum(Range("av2:av10000")) / 2
             ElseIf y1 = 3 Then
             Range("aw" & i) = y1
             Range("x8") = Application.sum(Range("aw2:aw10000")) / 3
             ElseIf y1 = 4 Then
             Range("ax" & i) = y1
             Range("x9") = Application.sum(Range("ax2:ax10000")) / 4
             End If
            
            
             If y22 = 1 Then
             Range("ay" & i) = y22
             Range("y6") = Application.sum(Range("ay2:ay10000"))
             ElseIf y22 = 2 Then
             Range("az" & i) = y22
             Range("y7") = Application.sum(Range("az2:az10000")) / 2
             ElseIf y22 = 3 Then
             Range("ba" & i) = y22
             Range("y8") = Application.sum(Range("ba2:ba10000")) / 3
             ElseIf y22 = 4 Then
             Range("bb" & i) = y22
             Range("y9") = Application.sum(Range("bb2:bb10000")) / 4
             End If
            
             If y3 = 1 Then
             Range("bc" & i) = y3
             Range("z6") = Application.sum(Range("bc2:bc10000"))
             ElseIf y3 = 2 Then
             Range("bd" & i) = y3
             Range("z7") = Application.sum(Range("bd2:bd10000")) / 2
             ElseIf y3 = 3 Then
             Range("be" & i) = y3
             Range("z8") = Application.sum(Range("be2:be10000")) / 3
             ElseIf y3 = 4 Then
             Range("bf" & i) = y3
             Range("z9") = Application.sum(Range("bf2:bf10000")) / 4
             End If
            
     End If
End If
End If


' 3 eme feuille

If Worksheets("NEW_VB_config").Range("o" & 4) <> "" Then
'c = Worksheets("NEW_VB_config").Range("o" & 4)
If Worksheets(c).Range("n" & i) <> "" Then

x = Left(Worksheets(c).Range("n" & i), 1)
y = Left(Worksheets(c).Range("n" & i), 2)
y1 = Right(y, 1)
y2 = Left(Worksheets(c).Range("n" & i), 3)
y22 = Right(y2, 1)
y3 = Right(Worksheets(c).Range("n" & i), 1)

    If Worksheets(c).Range("a" & i) = Range("a1") Then

          If x = 1 Then
             Range("bg" & i) = x
             Range("w10") = Application.sum(Range("bg2:bg10000"))
             ElseIf x = 2 Then
             Range("bh" & i) = x
             Range("w11") = Application.sum(Range("bh2:bh10000")) / 2
             ElseIf x = 3 Then
             Range("bi" & i) = x
             Range("w12") = Application.sum(Range("bi2:bi10000")) / 3
             ElseIf x = 4 Then
             Range("bj" & i) = x
             Range("w13") = Application.sum(Range("bj2:bj10000")) / 4
             End If
            
             If y1 = 1 Then
             Range("bk" & i) = y1
             Range("x10") = Application.sum(Range("bk2:bk10000"))
             ElseIf y1 = 2 Then
             Range("bl" & i) = y1
             Range("x11") = Application.sum(Range("bl2:bl10000")) / 2
             ElseIf y1 = 3 Then
             Range("bm" & i) = y1
             Range("x12") = Application.sum(Range("bm2:bm10000")) / 3
             ElseIf y1 = 4 Then
             Range("bn" & i) = y1
             Range("x13") = Application.sum(Range("bn2:bn10000")) / 4
             End If
            
            
             If y22 = 1 Then
             Range("bo" & i) = y22
             Range("y10") = Application.sum(Range("bo2:bo10000"))
             ElseIf y22 = 2 Then
             Range("bp" & i) = y22
             Range("y11") = Application.sum(Range("bp2:bp10000")) / 2
             ElseIf y22 = 3 Then
             Range("bq" & i) = y22
             Range("y12") = Application.sum(Range("bq2:bq10000")) / 3
             ElseIf y22 = 4 Then
             Range("br" & i) = y22
             Range("y13") = Application.sum(Range("br2:br10000")) / 4
             End If
            
             If y3 = 1 Then
             Range("bs" & i) = y3
             Range("z10") = Application.sum(Range("bs2:bs10000"))
             ElseIf y3 = 2 Then
             Range("bt" & i) = y3
             Range("z11") = Application.sum(Range("bt2:bt10000")) / 2
             ElseIf y3 = 3 Then
             Range("bu" & i) = y3
             Range("z12") = Application.sum(Range("bu2:bu10000")) / 3
             ElseIf y3 = 4 Then
             Range("bv" & i) = y3
             Range("z13") = Application.sum(Range("bv2:bv10000")) / 4
             End If
            
     End If
End If
End If

' 4 eme feuille

If Worksheets("NEW_VB_config").Range("o" & 5) <> "" Then
'd = Worksheets("NEW_VB_config").Range("o" & 5)
If Worksheets(d).Range("n" & i) <> "" Then

x = Left(Worksheets(d).Range("n" & i), 1)
y = Left(Worksheets(d).Range("n" & i), 2)
y1 = Right(y, 1)
y2 = Left(Worksheets(d).Range("n" & i), 3)
y22 = Right(y2, 1)
y3 = Right(Worksheets(d).Range("n" & i), 1)

    If Worksheets(d).Range("a" & i) = Range("a1") Then

          If x = 1 Then
             Range("bw" & i) = x
             Range("w14") = Application.sum(Range("bw2:bw10000"))
             ElseIf x = 2 Then
             Range("bx" & i) = x
             Range("w15") = Application.sum(Range("bx2:bx10000")) / 2
             ElseIf x = 3 Then
             Range("by" & i) = x
             Range("w16") = Application.sum(Range("by2:by10000")) / 3
             ElseIf x = 4 Then
             Range("bz" & i) = x
             Range("w17") = Application.sum(Range("bz2:bz10000")) / 4
             End If
            
             If y1 = 1 Then
             Range("ca" & i) = y1
             Range("x14") = Application.sum(Range("ca2:ca10000"))
             ElseIf y1 = 2 Then
             Range("cb" & i) = y1
             Range("x15") = Application.sum(Range("cb2:cb10000")) / 2
             ElseIf y1 = 3 Then
             Range("cc" & i) = y1
             Range("x16") = Application.sum(Range("cc2:cc10000")) / 3
             ElseIf y1 = 4 Then
             Range("cd" & i) = y1
             Range("x17") = Application.sum(Range("cd2:cd10000")) / 4
             End If
            
            
             If y22 = 1 Then
             Range("ce" & i) = y22
             Range("y14") = Application.sum(Range("ce2:ce10000"))
             ElseIf y22 = 2 Then
             Range("cf" & i) = y22
             Range("y15") = Application.sum(Range("cf2:cf10000")) / 2
             ElseIf y22 = 3 Then
             Range("cg" & i) = y22
             Range("y16") = Application.sum(Range("cg2:cg10000")) / 3
             ElseIf y22 = 4 Then
             Range("ch" & i) = y22
             Range("y17") = Application.sum(Range("ch2:ch10000")) / 4
             End If
            
             If y3 = 1 Then
             Range("ci" & i) = y3
             Range("z14") = Application.sum(Range("ci2:ci10000"))
             ElseIf y3 = 2 Then
             Range("cj" & i) = y3
             Range("z15") = Application.sum(Range("cj2:cj10000")) / 2
             ElseIf y3 = 3 Then
             Range("ck" & i) = y3
             Range("z16") = Application.sum(Range("ck2:ck10000")) / 3
             ElseIf y3 = 4 Then
             Range("cl" & i) = y3
             Range("z17") = Application.sum(Range("cl2:cl10000")) / 4
             End If
            
     End If
End If
End If

' 5 eme feuille

If Worksheets("NEW_VB_config").Range("o" & 6) <> "" Then
'E = Worksheets("NEW_VB_config").Range("o" & 6)
If Worksheets(E).Range("n" & i) <> "" Then

x = Left(Worksheets(E).Range("n" & i), 1)
y = Left(Worksheets(E).Range("n" & i), 2)
y1 = Right(y, 1)
y2 = Left(Worksheets(E).Range("n" & i), 3)
y22 = Right(y2, 1)
y3 = Right(Worksheets(E).Range("n" & i), 1)

    If Worksheets(E).Range("a" & i) = Range("a1") Then

          If x = 1 Then
             Range("cm" & i) = x
             Range("w18") = Application.sum(Range("cm2:cm10000"))
             ElseIf x = 2 Then
             Range("cn" & i) = x
             Range("w19") = Application.sum(Range("cn2:cn10000")) / 2
             ElseIf x = 3 Then
             Range("co" & i) = x
             Range("w20") = Application.sum(Range("co2:co10000")) / 3
             ElseIf x = 4 Then
             Range("cp" & i) = x
             Range("w21") = Application.sum(Range("cp2:cp10000")) / 4
             End If
            
             If y1 = 1 Then
             Range("cq" & i) = y1
             Range("x18") = Application.sum(Range("cq2:cq10000"))
             ElseIf y1 = 2 Then
             Range("cr" & i) = y1
             Range("x19") = Application.sum(Range("cr2:cr10000")) / 2
             ElseIf y1 = 3 Then
             Range("cs" & i) = y1
             Range("x20") = Application.sum(Range("cs2:cs10000")) / 3
             ElseIf y1 = 4 Then
             Range("ct" & i) = y1
             Range("x21") = Application.sum(Range("ct2:ct10000")) / 4
             End If
            
            
             If y22 = 1 Then
             Range("cu" & i) = y22
             Range("y18") = Application.sum(Range("cu2:cu10000"))
             ElseIf y22 = 2 Then
             Range("cv" & i) = y22
             Range("y19") = Application.sum(Range("cv2:cv10000")) / 2
             ElseIf y22 = 3 Then
             Range("cw" & i) = y22
             Range("y20") = Application.sum(Range("cw2:cw10000")) / 3
             ElseIf y22 = 4 Then
             Range("cx" & i) = y22
             Range("y21") = Application.sum(Range("cx2:cx10000")) / 4
             End If
            
             If y3 = 1 Then
             Range("cy" & i) = y3
             Range("z18") = Application.sum(Range("cy2:cy10000"))
             ElseIf y3 = 2 Then
             Range("cz" & i) = y3
             Range("z19") = Application.sum(Range("cz2:cz10000")) / 2
             ElseIf y3 = 3 Then
             Range("da" & i) = y3
             Range("z20") = Application.sum(Range("da2:da10000")) / 3
             ElseIf y3 = 4 Then
             Range("db" & i) = y3
             Range("z21") = Application.sum(Range("db2:db10000")) / 4
             End If
            
     End If
End If
End If

' 6 eme feuille

If Worksheets("NEW_VB_config").Range("o" & 7) <> "" Then
'f = Worksheets("NEW_VB_config").Range("o" & 7)


If Worksheets(f).Range("n" & i) <> "" Then

x = Left(Worksheets(f).Range("n" & i), 1)
y = Left(Worksheets(f).Range("n" & i), 2)
y1 = Right(y, 1)
y2 = Left(Worksheets(f).Range("n" & i), 3)
y22 = Right(y2, 1)
y3 = Right(Worksheets(f).Range("n" & i), 1)

    If Worksheets(f).Range("a" & i) = Range("a1") Then

          If x = 1 Then
             Range("dc" & i) = x
             Range("w22") = Application.sum(Range("dc2:dc10000"))
             ElseIf x = 2 Then
             Range("dd" & i) = x
             Range("w23") = Application.sum(Range("dd2:dd10000")) / 2
             ElseIf x = 3 Then
             Range("de" & i) = x
             Range("w24") = Application.sum(Range("de2:de10000")) / 3
             ElseIf x = 4 Then
             Range("df" & i) = x
             Range("w25") = Application.sum(Range("df2:df10000")) / 4
             End If
            
             If y1 = 1 Then
             Range("dg" & i) = y1
             Range("x22") = Application.sum(Range("dg2:dg10000"))
             ElseIf y1 = 2 Then
             Range("dh" & i) = y1
             Range("x23") = Application.sum(Range("dh2:dh10000")) / 2
             ElseIf y1 = 3 Then
             Range("di" & i) = y1
             Range("x24") = Application.sum(Range("di2:di10000")) / 3
             ElseIf y1 = 4 Then
             Range("dj" & i) = y1
             Range("x25") = Application.sum(Range("dj2:dj10000")) / 4
             End If
            
            
             If y22 = 1 Then
             Range("dk" & i) = y22
             Range("y22") = Application.sum(Range("dk2:dk10000"))
             ElseIf y22 = 2 Then
             Range("dl" & i) = y22
             Range("y23") = Application.sum(Range("dl2:dl10000")) / 2
             ElseIf y22 = 3 Then
             Range("dm" & i) = y22
             Range("y24") = Application.sum(Range("dm2:dm10000")) / 3
             ElseIf y22 = 4 Then
             Range("dn" & i) = y22
             Range("y25") = Application.sum(Range("dn2:dn10000")) / 4
             End If
            
             If y3 = 1 Then
             Range("do" & i) = y3
             Range("z22") = Application.sum(Range("do2:do10000"))
             ElseIf y3 = 2 Then
             Range("dp" & i) = y3
             Range("z23") = Application.sum(Range("dp2:dp10000")) / 2
             ElseIf y3 = 3 Then
             Range("dq" & i) = y3
             Range("z24") = Application.sum(Range("dq2:dq10000")) / 3
             ElseIf y3 = 4 Then
             Range("dr" & i) = y3
             Range("z25") = Application.sum(Range("drl2:drl10000")) / 4
             End If
            
     End If
End If

End If

' 7 eme feuille

If Worksheets("NEW_VB_config").Range("o" & 8) <> "" Then
'g = Worksheets("NEW_VB_config").Range("o" & 8)


If Worksheets(g).Range("n" & i) <> "" Then

x = Left(Worksheets(g).Range("n" & i), 1)
y = Left(Worksheets(g).Range("n" & i), 2)
y1 = Right(y, 1)
y2 = Left(Worksheets(g).Range("n" & i), 3)
y22 = Right(y2, 1)
y3 = Right(Worksheets(g).Range("n" & i), 1)

    If Worksheets(g).Range("a" & i) = Range("a1") Then

          If x = 1 Then
             Range("ds" & i) = x
             Range("w26") = Application.sum(Range("ds2:ds10000"))
             ElseIf x = 2 Then
             Range("dt" & i) = x
             Range("w27") = Application.sum(Range("dt2:dt10000")) / 2
             ElseIf x = 3 Then
             Range("du" & i) = x
             Range("w28") = Application.sum(Range("du2:du10000")) / 3
             ElseIf x = 4 Then
             Range("dv" & i) = x
             Range("w29") = Application.sum(Range("dv2:dv10000")) / 4
             End If
            
             If y1 = 1 Then
             Range("dw" & i) = y1
             Range("x26") = Application.sum(Range("dw2:dw10000"))
             ElseIf y1 = 2 Then
             Range("dx" & i) = y1
             Range("x27") = Application.sum(Range("dx2:dx10000")) / 2
             ElseIf y1 = 3 Then
             Range("dy" & i) = y1
             Range("x28") = Application.sum(Range("dy2:dy10000")) / 3
             ElseIf y1 = 4 Then
             Range("dz" & i) = y1
             Range("x29") = Application.sum(Range("dz2:dz10000")) / 4
             End If
            
            
             If y22 = 1 Then
             Range("ea" & i) = y22
             Range("y26") = Application.sum(Range("ea2:ea10000"))
             ElseIf y22 = 2 Then
             Range("eb" & i) = y22
             Range("y27") = Application.sum(Range("eb2:eb10000")) / 2
             ElseIf y22 = 3 Then
             Range("ec" & i) = y22
             Range("y28") = Application.sum(Range("ec2:ec10000")) / 3
             ElseIf y22 = 4 Then
             Range("ed" & i) = y22
             Range("y29") = Application.sum(Range("ed2:ed10000")) / 4
             End If
            
             If y3 = 1 Then
             Range("ee" & i) = y3
             Range("z26") = Application.sum(Range("ee2:ee10000"))
             ElseIf y3 = 2 Then
             Range("ef" & i) = y3
             Range("z27") = Application.sum(Range("ef2:ef10000")) / 2
             ElseIf y3 = 3 Then
             Range("eg" & i) = y3
             Range("z28") = Application.sum(Range("eg2:eg10000")) / 3
             ElseIf y3 = 4 Then
             Range("eh" & i) = y3
             Range("z29") = Application.sum(Range("ehl2:ehl10000")) / 4
             End If
            
     End If
End If
End If


' 8 eme feuille

If Worksheets("NEW_VB_config").Range("o" & 9) <> "" Then
'h = Worksheets("NEW_VB_config").Range("o" & 9)


If Worksheets(h).Range("n" & i) <> "" Then

x = Left(Worksheets(h).Range("n" & i), 1)
y = Left(Worksheets(h).Range("n" & i), 2)
y1 = Right(y, 1)
y2 = Left(Worksheets(h).Range("n" & i), 3)
y22 = Right(y2, 1)
y3 = Right(Worksheets(h).Range("n" & i), 1)

    If Worksheets(h).Range("a" & i) = Range("a1") Then

          If x = 1 Then
             Range("ei" & i) = x
             Range("w30") = Application.sum(Range("ei2:ei10000"))
             ElseIf x = 2 Then
             Range("ej" & i) = x
             Range("w31") = Application.sum(Range("ej2:ej10000")) / 2
             ElseIf x = 3 Then
             Range("ek" & i) = x
             Range("w32") = Application.sum(Range("ek2:ek10000")) / 3
             ElseIf x = 4 Then
             Range("el" & i) = x
             Range("w33") = Application.sum(Range("el2:el10000")) / 4
             End If
            
             If y1 = 1 Then
             Range("em" & i) = y1
             Range("x30") = Application.sum(Range("em2:em10000"))
             ElseIf y1 = 2 Then
             Range("en" & i) = y1
             Range("x31") = Application.sum(Range("en2:en10000")) / 2
             ElseIf y1 = 3 Then
             Range("eo" & i) = y1
             Range("x32") = Application.sum(Range("eo2:eo10000")) / 3
             ElseIf y1 = 4 Then
             Range("ep" & i) = y1
             Range("x33") = Application.sum(Range("ep2:ep10000")) / 4
             End If
            
            
             If y22 = 1 Then
             Range("eq" & i) = y22
             Range("y30") = Application.sum(Range("eq2:eq10000"))
             ElseIf y22 = 2 Then
             Range("er" & i) = y22
             Range("y31") = Application.sum(Range("er2:er10000")) / 2
             ElseIf y22 = 3 Then
             Range("es" & i) = y22
             Range("y32") = Application.sum(Range("es2:es10000")) / 3
             ElseIf y22 = 4 Then
             Range("et" & i) = y22
             Range("y33") = Application.sum(Range("et2:et10000")) / 4
             End If
            
             If y3 = 1 Then
             Range("eu" & i) = y3
             Range("z30") = Application.sum(Range("eu2:eu10000"))
             ElseIf y3 = 2 Then
             Range("ev" & i) = y3
             Range("z31") = Application.sum(Range("ev2:ev10000")) / 2
             ElseIf y3 = 3 Then
             Range("ew" & i) = y3
             Range("z32") = Application.sum(Range("ew2:ew10000")) / 3
             ElseIf y3 = 4 Then
             Range("ex" & i) = y3
             Range("z33") = Application.sum(Range("exl2:exl10000")) / 4
             End If
            
     End If
End If
End If


' 9 eme feuille

If Worksheets("NEW_VB_config").Range("o" & 10) <> "" Then
'i = Worksheets("NEW_VB_config").Range("o" & 10)


If Worksheets(i).Range("n" & i) <> "" Then

x = Left(Worksheets(i).Range("n" & i), 1)
y = Left(Worksheets(i).Range("n" & i), 2)
y1 = Right(y, 1)
y2 = Left(Worksheets(i).Range("n" & i), 3)
y22 = Right(y2, 1)
y3 = Right(Worksheets(i).Range("n" & i), 1)

    If Worksheets(i).Range("a" & i) = Range("a1") Then

          If x = 1 Then
             Range("ey" & i) = x
             Range("w34") = Application.sum(Range("ey2:ey10000"))
             ElseIf x = 2 Then
             Range("ez" & i) = x
             Range("w35") = Application.sum(Range("ez2:ez10000")) / 2
             ElseIf x = 3 Then
             Range("fa" & i) = x
             Range("w36") = Application.sum(Range("fa2:fa10000")) / 3
             ElseIf x = 4 Then
             Range("fb" & i) = x
             Range("w37") = Application.sum(Range("fb2:fb10000")) / 4
             End If
            
             If y1 = 1 Then
             Range("fc" & i) = y1
             Range("x34") = Application.sum(Range("fc2:fc10000"))
             ElseIf y1 = 2 Then
             Range("fd" & i) = y1
             Range("x35") = Application.sum(Range("fd2:fd10000")) / 2
             ElseIf y1 = 3 Then
             Range("fe" & i) = y1
             Range("x36") = Application.sum(Range("fe2:fe10000")) / 3
             ElseIf y1 = 4 Then
             Range("ff" & i) = y1
             Range("x37") = Application.sum(Range("ff2:ff10000")) / 4
             End If
            
            
             If y22 = 1 Then
             Range("fg" & i) = y22
             Range("y34") = Application.sum(Range("fg2:fg10000"))
             ElseIf y22 = 2 Then
             Range("fh" & i) = y22
             Range("y35") = Application.sum(Range("fh2:fh10000")) / 2
             ElseIf y22 = 3 Then
             Range("fi" & i) = y22
             Range("y36") = Application.sum(Range("fi2:fi10000")) / 3
             ElseIf y22 = 4 Then
             Range("fj" & i) = y22
             Range("y37") = Application.sum(Range("fj2:fj10000")) / 4
             End If
            
             If y3 = 1 Then
             Range("fk" & i) = y3
             Range("z34") = Application.sum(Range("fk2:fk10000"))
             ElseIf y3 = 2 Then
             Range("fl" & i) = y3
             Range("z35") = Application.sum(Range("fl2:fl10000")) / 2
             ElseIf y3 = 3 Then
             Range("fm" & i) = y3
             Range("z36") = Application.sum(Range("fm2:fm10000")) / 3
             ElseIf y3 = 4 Then
             Range("fn" & i) = y3
             Range("z37") = Application.sum(Range("fnl2:fnl10000")) / 4
             End If
            
     End If
End If
End If



' 10 eme feuille

If Worksheets("NEW_VB_config").Range("o" & 11) <> "" Then
'j = Worksheets("NEW_VB_config").Range("o" & 11)


If Worksheets(j).Range("n" & i) <> "" Then

x = Left(Worksheets(j).Range("n" & i), 1)
y = Left(Worksheets(j).Range("n" & i), 2)
y1 = Right(y, 1)
y2 = Left(Worksheets(j).Range("n" & i), 3)
y22 = Right(y2, 1)
y3 = Right(Worksheets(j).Range("n" & i), 1)

    If Worksheets(j).Range("a" & i) = Range("a1") Then

          If x = 1 Then
             Range("fo" & i) = x
             Range("w38") = Application.sum(Range("fo2:fo10000"))
             ElseIf x = 2 Then
             Range("fp" & i) = x
             Range("w39") = Application.sum(Range("fp2:fp10000")) / 2
             ElseIf x = 3 Then
             Range("fq" & i) = x
             Range("w40") = Application.sum(Range("fq2:fq10000")) / 3
             ElseIf x = 4 Then
             Range("fr" & i) = x
             Range("w41") = Application.sum(Range("fr2:fr10000")) / 4
             End If
            
             If y1 = 1 Then
             Range("fs" & i) = y1
             Range("x38") = Application.sum(Range("fs2:fs10000"))
             ElseIf y1 = 2 Then
             Range("ft" & i) = y1
             Range("x39") = Application.sum(Range("ft2:ft10000")) / 2
             ElseIf y1 = 3 Then
             Range("fu" & i) = y1
             Range("x40") = Application.sum(Range("fu2:fu10000")) / 3
             ElseIf y1 = 4 Then
             Range("fv" & i) = y1
             Range("x41") = Application.sum(Range("fv2:fv10000")) / 4
             End If
            
            
             If y22 = 1 Then
             Range("fw" & i) = y22
             Range("y38") = Application.sum(Range("fw2:fw10000"))
             ElseIf y22 = 2 Then
             Range("fx" & i) = y22
             Range("y39") = Application.sum(Range("fx2:fx10000")) / 2
             ElseIf y22 = 3 Then
             Range("fy" & i) = y22
             Range("y40") = Application.sum(Range("fy2:fy10000")) / 3
             ElseIf y22 = 4 Then
             Range("fz" & i) = y22
             Range("y41") = Application.sum(Range("fz2:fz10000")) / 4
             End If
            
             If y3 = 1 Then
             Range("ga" & i) = y3
             Range("z38") = Application.sum(Range("ga2:ga10000"))
             ElseIf y3 = 2 Then
             Range("gb" & i) = y3
             Range("z39") = Application.sum(Range("gb2:gb10000")) / 2
             ElseIf y3 = 3 Then
             Range("gc" & i) = y3
             Range("z40") = Application.sum(Range("gc2:gc10000")) / 3
             ElseIf y3 = 4 Then
             Range("gd" & i) = y3
             Range("z41") = Application.sum(Range("gdl2:gdl10000")) / 4
             End If
            
     End If
End If
End If


' 11 eme feuille

If Worksheets("NEW_VB_config").Range("o" & 12) <> "" Then
'k = Worksheets("NEW_VB_config").Range("o" & 12)


If Worksheets(k).Range("n" & i) <> "" Then

x = Left(Worksheets(k).Range("n" & i), 1)
y = Left(Worksheets(k).Range("n" & i), 2)
y1 = Right(y, 1)
y2 = Left(Worksheets(k).Range("n" & i), 3)
y22 = Right(y2, 1)
y3 = Right(Worksheets(k).Range("n" & i), 1)

    If Worksheets(k).Range("a" & i) = Range("a1") Then

          If x = 1 Then
             Range("ge" & i) = x
             Range("w42") = Application.sum(Range("ge2:fo10000"))
             ElseIf x = 2 Then
             Range("gf" & i) = x
             Range("w43") = Application.sum(Range("gf2:gf10000")) / 2
             ElseIf x = 3 Then
             Range("gg" & i) = x
             Range("w44") = Application.sum(Range("gg2:gg10000")) / 3
             ElseIf x = 4 Then
             Range("gh" & i) = x
             Range("w45") = Application.sum(Range("gh2:gh10000")) / 4
             End If
            
             If y1 = 1 Then
             Range("gi" & i) = y1
             Range("x42") = Application.sum(Range("gi2:gi10000"))
             ElseIf y1 = 2 Then
             Range("gj" & i) = y1
             Range("x43") = Application.sum(Range("gj2:gj10000")) / 2
             ElseIf y1 = 3 Then
             Range("gk" & i) = y1
             Range("x44") = Application.sum(Range("gk2:gk10000")) / 3
             ElseIf y1 = 4 Then
             Range("gl" & i) = y1
             Range("x45") = Application.sum(Range("gl2:gl10000")) / 4
             End If
            
            
             If y22 = 1 Then
             Range("gm" & i) = y22
             Range("y42") = Application.sum(Range("gm2:gm10000"))
             ElseIf y22 = 2 Then
             Range("gn" & i) = y22
             Range("y43") = Application.sum(Range("gn2:gn10000")) / 2
             ElseIf y22 = 3 Then
             Range("go" & i) = y22
             Range("y44") = Application.sum(Range("go2:go10000")) / 3
             ElseIf y22 = 4 Then
             Range("gp" & i) = y22
             Range("y45") = Application.sum(Range("gp2:gp10000")) / 4
             End If
            
             If y3 = 1 Then
             Range("gq" & i) = y3
             Range("z42") = Application.sum(Range("gq2:gq10000"))
             ElseIf y3 = 2 Then
             Range("gr" & i) = y3
             Range("z43") = Application.sum(Range("gr2:gr10000")) / 2
             ElseIf y3 = 3 Then
             Range("gs" & i) = y3
             Range("z44") = Application.sum(Range("gs2:gs10000")) / 3
             ElseIf y3 = 4 Then
             Range("gt" & i) = y3
             Range("z45") = Application.sum(Range("gtl2:gtl10000")) / 4
             End If
            
     End If
End If
End If

Next

'For i = 0 To 3
    'For j = 0 To 3
        'tst = Range("w2").offset(i, j).Value
        'For k = 1 To 10
            'tst = tst + Range("w2").offset(k * 4, j).Value
        'Next k
       ' Range("B2").offset(i, j) = tst
    'Next j
'Next i

Range("b2") = Range("w2") + Range("w6") + Range("w10") + Range("w14") + Range("w18") + Range("w22") + Range("w26") + Range("w30") + Range("w34") + Range("w38") + Range("w42")
Range("b3") = Range("w3") + Range("w7") + Range("w11") + Range("w15") + Range("w19") + Range("w23") + Range("w27") + Range("w31") + Range("w35") + Range("w39") + Range("w43")
Range("b4") = Range("w4") + Range("w8") + Range("w12") + Range("w16") + Range("w20") + Range("w24") + Range("w28") + Range("w32") + Range("w36") + Range("w40") + Range("w44")
Range("b5") = Range("w5") + Range("w9") + Range("w13") + Range("w17") + Range("w21") + Range("w25") + Range("w29") + Range("w33") + Range("w37") + Range("w41") + Range("w45")


Range("c2") = Range("x2") + Range("x6") + Range("x10") + Range("x14") + Range("x18") + Range("x22") + Range("x26") + Range("x30") + Range("x34") + Range("x38") + Range("x42")
Range("c3") = Range("x3") + Range("x7") + Range("x11") + Range("x15") + Range("x19") + Range("x23") + Range("x27") + Range("x30") + Range("x35") + Range("x39") + Range("x43")
Range("c4") = Range("x4") + Range("x8") + Range("x12") + Range("x16") + Range("x20") + Range("x24") + Range("x28") + Range("x30") + Range("x36") + Range("x40") + Range("x44")
Range("c5") = Range("x5") + Range("x9") + Range("x13") + Range("x17") + Range("x21") + Range("x25") + Range("x29") + Range("x30") + Range("x37") + Range("x41") + Range("x45")

Range("d2") = Range("y2") + Range("y6") + Range("y10") + Range("y14") + Range("y18") + Range("y22") + Range("y26") + Range("y30") + Range("y34") + Range("y38") + Range("y42")
Range("d3") = Range("y3") + Range("y7") + Range("y11") + Range("y15") + Range("y19") + Range("y23") + Range("y27") + Range("y30") + Range("y35") + Range("y39") + Range("y43")
Range("d4") = Range("y4") + Range("y8") + Range("y12") + Range("y16") + Range("y20") + Range("y24") + Range("y28") + Range("y30") + Range("y36") + Range("y40") + Range("y44")
Range("d5") = Range("y5") + Range("y9") + Range("y13") + Range("y17") + Range("y21") + Range("y25") + Range("y29") + Range("y30") + Range("y37") + Range("y41") + Range("y45")

Range("e2") = Range("z2") + Range("z6") + Range("z10") + Range("z14") + Range("z18") + Range("z22") + Range("z26") + Range("z30") + Range("z34") + Range("z38") + Range("z42")
Range("e3") = Range("z3") + Range("z7") + Range("z11") + Range("z15") + Range("z19") + Range("z23") + Range("z27") + Range("z30") + Range("z35") + Range("z39") + Range("z43")
Range("e4") = Range("z4") + Range("z8") + Range("z12") + Range("z16") + Range("z20") + Range("z24") + Range("z28") + Range("z30") + Range("z36") + Range("z40") + Range("z44")
Range("e5") = Range("z5") + Range("z9") + Range("z13") + Range("z17") + Range("z21") + Range("z25") + Range("z29") + Range("z30") + Range("z37") + Range("z41") + Range("z45")


For i = 2 To 5
For j = 2 To 5
If Cells(i, j) = 0 Then
Cells(i, j) = ""
End If
Next
Next

For i = 2 To 60
For j = 23 To 26
Cells(i, j) = ""
Next
Next

Columns("aa:zz").ClearContents
End Sub

Staple1600 · 4 Avril 2019

Bonsoir

BIL boud
Du code VBA formaté dans le message avec la balise BBCODE, c'est bien
Un fichier Excel exemple (anonymisé) fourni par le demandeur permettant de tester ce même code, c'est mieux

(Et cela évite aux répondeurs de perdre leur temps à recréer un classeur qui existe déjà sur le disque dur du demandeur, non ?)

BIL boud · 5 Avril 2019

bonjour

voici le fichier excel

dans l'onglet "NEW_VB_config" ya 2 liste
ce que le programme fait, c de balayer la liste "Sheets list" dans la colonne "O" en fonction de la liste "Project list" la colonne "Q"

moi jai creer un programme qui est long il fonctionne tres bien , ja creer dans longlet "ESSAI_QPDC" une synthses qui fait verefifier l'etat d'avencement des defferent projets "Transversal, Divers ......"
pour cela je selectionne a partir d'une liste deroulente dans longlet "ESSAI_QPDC" un projet et jaurrai la synthèse, maintenenat je veuxx creer le mm tableau pour chaque projet (suprimmer la liste deroulante) et fixer des tableaux dans la feuille "ESSAI_QPDC", comme ca je clique sur le bouton et je vais avoir la synthese de tt les projets sans passer par la listte deroulante

les tableaux seront creer just au desous de mon premier tableau en laissant une lisgne ou 2 ligne vide
jespere etre plus claire

merci d'avance

BIL boud · 5 Avril 2019

Staple1600 à dit:
Bonsoir

BIL boud
Du code VBA formaté dans le message avec la balise BBCODE, c'est bien
Un fichier Excel exemple (anonymisé) fourni par le demandeur permettant de tester ce même code, c'est mieux
(Et cela évite aux répondeurs de perdre leur temps à recréer un classeur qui existe déjà sur le disque dur du demandeur, non ?)

bonjour comme vous lavez demander jai joint le fichier excel et editer mon poste merci

BIL boud · 5 Avril 2019

Bonjour

jai essayer ce code mais ca fonctionne pas il me met erreur "objets requis "

je ne sais pas ou est l'erreur

VB:

Option Explicit
Public nb_speciality As Integer
Public speciality1 As String
Public speciality2 As String
Public speciality3 As String
Public speciality4 As String
Public speciality5 As String
Public speciality6 As String
Public speciality7 As String
Public speciality8 As String
Public speciality9 As String
Public speciality10 As String
Public speciality11 As String
Public speciality12 As String
Public speciality As String
Public list_speciality() As Variant

'CODE
Sub essai_qpdc()

Dim k, n, i, j As Integer
Dim x As Integer
Dim y As Integer
Dim y1 As Integer
Dim y2 As Integer
Dim y22 As Integer
Dim y3 As Integer





nb_speciality = 11
speciality1 = Worksheets("NEW_VB_config").Range("o2").Value
speciality2 = Worksheets("NEW_VB_config").Range("o3").Value
speciality3 = Worksheets("NEW_VB_config").Range("o4").Value
speciality4 = Worksheets("NEW_VB_config").Range("o5").Value
speciality5 = Worksheets("NEW_VB_config").Range("o6").Value
speciality6 = Worksheets("NEW_VB_config").Range("o7").Value
speciality7 = Worksheets("NEW_VB_config").Range("o8").Value
speciality8 = Worksheets("NEW_VB_config").Range("o9").Value
speciality9 = Worksheets("NEW_VB_config").Range("o10").Value
speciality10 = Worksheets("NEW_VB_config").Range("o11").Value
speciality11 = Worksheets("NEW_VB_config").Range("o12").Value

ReDim list_speciality(nb_speciality - 1)
list_speciality(0) = speciality1
list_speciality(1) = speciality2
list_speciality(2) = speciality3
list_speciality(3) = speciality4
list_speciality(4) = speciality5
list_speciality(5) = speciality6
list_speciality(6) = speciality7
list_speciality(7) = speciality8
list_speciality(8) = speciality9
list_speciality(9) = speciality10
list_speciality(10) = speciality11




k = 0
n = 0
While list_speciality(n) <> ""

speciality = list_speciality(n)
Worksheets(speciality).AutoFilterMode = False
i = 0

While Worksheets(speciality).Range("n2").offset(i, 0).Value <> ""


x = Left(Worksheets(speciality).Range("n2").offset(i, 0).Value, 1)
y = Left(Worksheets(speciality).Range("n2").offset(i, 0).Value, 2)
y1 = Right(y, 1)
y2 = Left(Worksheets(speciality).Range("n2").offset(i, 0).Value, 3)
y22 = Right(y2, 1)
y3 = Right(Worksheets(speciality).Range("n2").offset(i, 0).Value, 1)

    If Worksheets(speciality).Range("a2").offset(i, 0).Value = Range("a1") Then
    For j = 2 To 1000
          If x = 1 Then
             Range("aa" & j).offset(0, k).Value = x
             Range("w2").offset(0, k).Value = Application.sum(Range("aa2:aa10000")).offset(0, k).Value
             ElseIf x = 2 Then
             Range("ab" & j).offset(0, k).Value = x
             Range("w3").offset(0, k).Value = Application.sum(Range("ab2:ab10000")).offset(0, k).Value / 2
             ElseIf x = 3 Then
             Range("ac" & j).offset(0, k).Value = x
             Range("w4").offset(0, k).Value = Application.sum(Range("ac2:ac10000")).offset(0, k).Value / 3
             ElseIf x = 4 Then
             Range("ad" & j).offset(0, k).Value = x
             Range("w5").offset(0, k).Value = Application.sum(Range("ad2:ad10000")).offset(0, k).Value / 4
             End If
            
             If y1 = 1 Then
             Range("ae" & j).offset(0, k).Value = y1
             Range("x2").offset(0, k).Value = Application.sum(Range("ae2:ae10000")).offset(0, k).Value
             ElseIf y1 = 2 Then
             Range("af" & j).offset(0, k).Value = y1
             Range("x3").offset(0, k).Value = Application.sum(Range("af2:af10000")).offset(0, k).Value / 2
             ElseIf y1 = 3 Then
             Range("ag" & j).offset(0, k).Value = y1
             Range("x4").offset(0, k).Value = Application.sum(Range("ag2:ag10000")).offset(0, k).Value / 3
             ElseIf y1 = 4 Then
             Range("ah" & j).offset(0, k).Value = y1
             Range("x5").offset(0, k).Value = Application.sum(Range("ah2:ah10000")).offset(0, k).Value / 4
             End If
            
            
             If y22 = 1 Then
             Range("ai" & j).offset(0, k).Value = y22
             Range("y2").offset(0, k).Value = Application.sum(Range("ai2:ai10000")).offset(0, k).Value
             ElseIf y22 = 2 Then
             Range("aj" & j).offset(0, k).Value = y22
             Range("y3").offset(0, k).Value = Application.sum(Range("aj2:aj10000")).offset(0, k).Value / 2
             ElseIf y22 = 3 Then
             Range("ak" & j).offset(0, k).Value = y22
             Range("y4").offset(0, k).Value = Application.sum(Range("ak2:ak10000")).offset(0, k).Value / 3
             ElseIf y22 = 4 Then
             Range("al" & j).offset(0, k).Value = y22
             Range("y5").offset(0, k).Value = Application.sum(Range("al2:al10000")).offset(0, k).Value / 4
             End If
            
             If y3 = 1 Then
             Range("am" & j).offset(0, k).Value = y3
             Range("z2").offset(0, k).Value = Application.sum(Range("am2:am10000")).offset(0, k).Value
             ElseIf y3 = 2 Then
             Range("an" & j).offset(0, k).Value = y3
             Range("z3").offset(0, k).Value = Application.sum(Range("an2:an10000")).offset(0, k).Value / 2
             ElseIf y3 = 3 Then
             Range("ao" & j).offset(0, k).Value = y3
             Range("z4").offset(0, k).Value = Application.sum(Range("ao2:ao10000")).offset(0, k).Value / 3
             ElseIf y3 = 4 Then
             Range("ap" & j).offset(0, k).Value = y3
             Range("z5").offset(0, k).Value = Application.sum(Range("ap2:ap10000")).offset(0, k).Value / 4
             End If
            
            
            
            
          Next j
          


      k = k + 16
      
    
    End If
    
 
    i = i + 1
Wend

 
n = n + 1
Wend

 

Range("b2") = Range("w2") + Range("w6") + Range("w10") + Range("w14") + Range("w18") + Range("w22") + Range("w26") + Range("w30") + Range("w34") + Range("w38") + Range("w42")
Range("b3") = Range("w3") + Range("w7") + Range("w11") + Range("w15") + Range("w19") + Range("w23") + Range("w27") + Range("w31") + Range("w35") + Range("w39") + Range("w43")
Range("b4") = Range("w4") + Range("w8") + Range("w12") + Range("w16") + Range("w20") + Range("w24") + Range("w28") + Range("w32") + Range("w36") + Range("w40") + Range("w44")
Range("b5") = Range("w5") + Range("w9") + Range("w13") + Range("w17") + Range("w21") + Range("w25") + Range("w29") + Range("w33") + Range("w37") + Range("w41") + Range("w45")


Range("c2") = Range("x2") + Range("x6") + Range("x10") + Range("x14") + Range("x18") + Range("x22") + Range("x26") + Range("x30") + Range("x34") + Range("x38") + Range("x42")
Range("c3") = Range("x3") + Range("x7") + Range("x11") + Range("x15") + Range("x19") + Range("x23") + Range("x27") + Range("x30") + Range("x35") + Range("x39") + Range("x43")
Range("c4") = Range("x4") + Range("x8") + Range("x12") + Range("x16") + Range("x20") + Range("x24") + Range("x28") + Range("x30") + Range("x36") + Range("x40") + Range("x44")
Range("c5") = Range("x5") + Range("x9") + Range("x13") + Range("x17") + Range("x21") + Range("x25") + Range("x29") + Range("x30") + Range("x37") + Range("x41") + Range("x45")

Range("d2") = Range("y2") + Range("y6") + Range("y10") + Range("y14") + Range("y18") + Range("y22") + Range("y26") + Range("y30") + Range("y34") + Range("y38") + Range("y42")
Range("d3") = Range("y3") + Range("y7") + Range("y11") + Range("y15") + Range("y19") + Range("y23") + Range("y27") + Range("y30") + Range("y35") + Range("y39") + Range("y43")
Range("d4") = Range("y4") + Range("y8") + Range("y12") + Range("y16") + Range("y20") + Range("y24") + Range("y28") + Range("y30") + Range("y36") + Range("y40") + Range("y44")
Range("d5") = Range("y5") + Range("y9") + Range("y13") + Range("y17") + Range("y21") + Range("y25") + Range("y29") + Range("y30") + Range("y37") + Range("y41") + Range("y45")

Range("e2") = Range("z2") + Range("z6") + Range("z10") + Range("z14") + Range("z18") + Range("z22") + Range("z26") + Range("z30") + Range("z34") + Range("z38") + Range("z42")
Range("e3") = Range("z3") + Range("z7") + Range("z11") + Range("z15") + Range("z19") + Range("z23") + Range("z27") + Range("z30") + Range("z35") + Range("z39") + Range("z43")
Range("e4") = Range("z4") + Range("z8") + Range("z12") + Range("z16") + Range("z20") + Range("z24") + Range("z28") + Range("z30") + Range("z36") + Range("z40") + Range("z44")
Range("e5") = Range("z5") + Range("z9") + Range("z13") + Range("z17") + Range("z21") + Range("z25") + Range("z29") + Range("z30") + Range("z37") + Range("z41") + Range("z45")








'For i = 2 To 5
'For j = 2 To 5
'If Cells(i, j) = 0 Then
'Cells(i, j) = ""
'End If
'Next
'Next

'For i = 2 To 60
'For j = 23 To 26
'Cells(i, j) = ""
'Next
'Next


Columns("aa:zz").ClearContents
End Sub
'FIN DE CODE

Staple1600 · 5 Avril 2019

Bonsoir

Merci d'avoir pris le temps de joindre un fichier exemple.
Pour le moment, je n'ai pas eu le temps d'investiguer plus loin.

ODVJ · 6 Avril 2019

Bonjour,

J'ai voulu ouvrir ton fichier mais j'ai un message de contenu illisible qui s'affiche.

cdlt

ODVJ · 6 Avril 2019

Bonjour,

Je n'ai travaillé que sur ton code, pas sur ton classeur.
Vu les cycles de tes affectations de valeurs, tu peux remplacer ton code par :

VB:

Sub essai_qpdc()
Dim a, b(4) As Integer, i As Integer, f As Integer, m As Integer
'b(1) = x
'b(2) = y1
'b(3) = y22
'b(4) = y3

a = Worksheets("NEW_VB_config").Range("o2:o12") 'nom des 11 feuilles
For i = 2 To 10000
  For f = 1 To 11                 'boucle sur les feuilles
    If a(f, 1) <> "" Then
      With Worksheets(a(f, 1))
        If .Range("n" & i).Value <> "" And .Range("a" & i).Value = ActiveSheet.Range("a1").Value Then
          For m = 1 To 4
            b(m) = Mid(.Range("n" & i), m, 1)
            If b(m) = 1 Or b(m) = 2 Or b(m) = 3 Or b(m) = 4 Then
              ActiveSheet.Range("aa" & i).Offset(0, 16 * (f - 1) + 4 * (m - 1) + b(m) - 1) = b(m)
              ActiveSheet.Range("w2").Offset(4 * (f - 1) + b(m) - 1, m - 1) = Application.Sum(ActiveSheet.Range("aa2").Offset(0, 16 * (f - 1) + 4 * (m - 1) + b(m) - 1).Resize(9999, 1)) / b(m)
            End If
          Next m
        End If
      End With
    End If
  Next f
Next i
End Sub

J'ai eu du mal à savoir à quelle feuille appartenaient tes Range non préfixés.
J'ai mis des ActiveSheet qui ne doivent pas être corrects, mais tu les changeras si nécessaire.

Remarques :
1) Pour y3, j'ai considéré que Worksheets(a).Range("n" & i) avait 4 caractères.
Si ça n'est pas le cas, il faut rajouter un Left (.Range("n" & i), 4)
2) le code est plus dense mais moins lisible

Cordialement

BIL boud · 7 Avril 2019

ODVJ à dit:
Bonjour,

Je n'ai travaillé que sur ton code, pas sur ton classeur.
Vu les cycles de tes affectations de valeurs, tu peux remplacer ton code par :

VB:

Sub essai_qpdc() Dim a, b(4) As Integer, i As Integer, f As Integer, m As Integer 'b(1) = x 'b(2) = y1 'b(3) = y22 'b(4) = y3 a = Worksheets("NEW_VB_config").Range("o2:o12") 'nom des 11 feuilles For i = 2 To 10000 For f = 1 To 11 'boucle sur les feuilles If a(f, 1) <> "" Then With Worksheets(a(f, 1)) If .Range("n" & i).Value <> "" And .Range("a" & i).Value = ActiveSheet.Range("a1").Value Then For m = 1 To 4 b(m) = Mid(.Range("n" & i), m, 1) If b(m) = 1 Or b(m) = 2 Or b(m) = 3 Or b(m) = 4 Then ActiveSheet.Range("aa" & i).Offset(0, 16 * (f - 1) + 4 * (m - 1) + b(m) - 1) = b(m) ActiveSheet.Range("w2").Offset(4 * (f - 1) + b(m) - 1, m - 1) = Application.Sum(ActiveSheet.Range("aa2").Offset(0, 16 * (f - 1) + 4 * (m - 1) + b(m) - 1).Resize(9999, 1)) / b(m) End If Next m End If End With End If Next f Next i End Sub

J'ai eu du mal à savoir à quelle feuille appartenaient tes Range non préfixés.
J'ai mis des ActiveSheet qui ne doivent pas être corrects, mais tu les changeras si nécessaire.

Remarques :
1) Pour y3, j'ai considéré que Worksheets(a).Range("n" & i) avait 4 caractères.
Si ça n'est pas le cas, il faut rajouter un Left (.Range("n" & i), 4)
2) le code est plus dense mais moins lisible

Cordialement

bonjour
dans mon pc le fichier souvre je ne sais pas ou est le probleme
oui pour y3 Worksheets(a).Range("n" & i) avait 4
merci pour le code que vous venez me donner , je vais le tester si ca marche

merci encore

BIL boud · 7 Avril 2019

ODVJ à dit:
Bonjour,

Je n'ai travaillé que sur ton code, pas sur ton classeur.
Vu les cycles de tes affectations de valeurs, tu peux remplacer ton code par :

VB:

Sub essai_qpdc() Dim a, b(4) As Integer, i As Integer, f As Integer, m As Integer 'b(1) = x 'b(2) = y1 'b(3) = y22 'b(4) = y3 a = Worksheets("NEW_VB_config").Range("o2:o12") 'nom des 11 feuilles For i = 2 To 10000 For f = 1 To 11 'boucle sur les feuilles If a(f, 1) <> "" Then With Worksheets(a(f, 1)) If .Range("n" & i).Value <> "" And .Range("a" & i).Value = ActiveSheet.Range("a1").Value Then For m = 1 To 4 b(m) = Mid(.Range("n" & i), m, 1) If b(m) = 1 Or b(m) = 2 Or b(m) = 3 Or b(m) = 4 Then ActiveSheet.Range("aa" & i).Offset(0, 16 * (f - 1) + 4 * (m - 1) + b(m) - 1) = b(m) ActiveSheet.Range("w2").Offset(4 * (f - 1) + b(m) - 1, m - 1) = Application.Sum(ActiveSheet.Range("aa2").Offset(0, 16 * (f - 1) + 4 * (m - 1) + b(m) - 1).Resize(9999, 1)) / b(m) End If Next m End If End With End If Next f Next i End Sub

J'ai eu du mal à savoir à quelle feuille appartenaient tes Range non préfixés.
J'ai mis des ActiveSheet qui ne doivent pas être corrects, mais tu les changeras si nécessaire.

Remarques :
1) Pour y3, j'ai considéré que Worksheets(a).Range("n" & i) avait 4 caractères.
Si ça n'est pas le cas, il faut rajouter un Left (.Range("n" & i), 4)
2) le code est plus dense mais moins lisible

Cordialement

Bonjour

je lai teste et ca marche super tres bien

merci bcp pour votre aide

BIL boud · 8 Avril 2019

Re bonjour

jai repris votre code et je voulais cette fois ci l'elargir au autres cas au lieu :

Code:

If .Range("n" & i).Value <> "" And .Range("a" & i).Value = ActiveSheet.Range("a1").Value

je le fais ausiis pour

Code:

If .Range("n" & i).Value <> "" And .Range("a" & i).Value = ActiveSheet.Range("a7").Value

If .Range("n" & i).Value <> "" And .Range("a" & i).Value = ActiveSheet.Range("a13").Value

If .Range("n" & i).Value <> "" And .Range("a" & i).Value = ActiveSheet.Range("a19").Value

If .Range("n" & i).Value <> "" And .Range("a" & i).Value = ActiveSheet.Range("a25").Value

If .Range("n" & i).Value <> "" And .Range("a" & i).Value = ActiveSheet.Range("a31").Value

If .Range("n" & i).Value <> "" And .Range("a" & i).Value = ActiveSheet.Range("a37").Value

 If .Range("n" & i).Value <> "" And .Range("a" & i).Value = ActiveSheet.Range("a43").Value

 If .Range("n" & i).Value <> "" And .Range("a" & i).Value = ActiveSheet.Range("a49").Value

 If .Range("n" & i).Value <> "" And .Range("a" & i).Value = ActiveSheet.Range("a55").Value

 If .Range("n" & i).Value <> "" And .Range("a" & i).Value = ActiveSheet.Range("a61").Value

voici le code que jai modifie

Code:

Sub essai_qpdc()

Columns("T:zz").Hidden = False
Dim a, b(4) As Integer, i As Integer, f As Integer, m As Integer


'feuil 1

a = Worksheets("NEW_VB_config").Range("o2:o12") 'nom des 11 feuilles
For i = 2 To 10000
  For f = 1 To 11                 'boucle sur les feuilles
    If a(f, 1) <> "" Then
      With Worksheets(a(f, 1))
        If .Range("n" & i).Value <> "" And .Range("a" & i).Value = ActiveSheet.Range("a1").Value Then
          For m = 1 To 4
            b(m) = Mid(.Range("n" & i), m, 1)
            If b(m) = 1 Or b(m) = 2 Or b(m) = 3 Or b(m) = 4 Then
              ActiveSheet.Range("aa" & i).Offset(0, 16 * (f - 1) + 4 * (m - 1) + b(m) - 1) = b(m)
              ActiveSheet.Range("w2").Offset(4 * (f - 1) + b(m) - 1, m - 1) = Application.Sum(ActiveSheet.Range("aa2").Offset(0, 16 * (f - 1) + 4 * (m - 1) + b(m) - 1).Resize(9999, 1)) / b(m)
            End If
          Next m
        End If
      End With
    End If
  Next f
Next i
Range("b2") = Range("w2") + Range("w6") + Range("w10") + Range("w14") + Range("w18") + Range("w22") + Range("w26") + Range("w30") + Range("w34") + Range("w38") + Range("w42")
Range("b3") = Range("w3") + Range("w7") + Range("w11") + Range("w15") + Range("w19") + Range("w23") + Range("w27") + Range("w31") + Range("w35") + Range("w39") + Range("w43")
Range("b4") = Range("w4") + Range("w8") + Range("w12") + Range("w16") + Range("w20") + Range("w24") + Range("w28") + Range("w32") + Range("w36") + Range("w40") + Range("w44")
Range("b5") = Range("w5") + Range("w9") + Range("w13") + Range("w17") + Range("w21") + Range("w25") + Range("w29") + Range("w33") + Range("w37") + Range("w41") + Range("w45")


Range("c2") = Range("x2") + Range("x6") + Range("x10") + Range("x14") + Range("x18") + Range("x22") + Range("x26") + Range("x30") + Range("x34") + Range("x38") + Range("x42")
Range("c3") = Range("x3") + Range("x7") + Range("x11") + Range("x15") + Range("x19") + Range("x23") + Range("x27") + Range("x30") + Range("x35") + Range("x39") + Range("x43")
Range("c4") = Range("x4") + Range("x8") + Range("x12") + Range("x16") + Range("x20") + Range("x24") + Range("x28") + Range("x30") + Range("x36") + Range("x40") + Range("x44")
Range("c5") = Range("x5") + Range("x9") + Range("x13") + Range("x17") + Range("x21") + Range("x25") + Range("x29") + Range("x30") + Range("x37") + Range("x41") + Range("x45")

Range("d2") = Range("y2") + Range("y6") + Range("y10") + Range("y14") + Range("y18") + Range("y22") + Range("y26") + Range("y30") + Range("y34") + Range("y38") + Range("y42")
Range("d3") = Range("y3") + Range("y7") + Range("y11") + Range("y15") + Range("y19") + Range("y23") + Range("y27") + Range("y30") + Range("y35") + Range("y39") + Range("y43")
Range("d4") = Range("y4") + Range("y8") + Range("y12") + Range("y16") + Range("y20") + Range("y24") + Range("y28") + Range("y30") + Range("y36") + Range("y40") + Range("y44")
Range("d5") = Range("y5") + Range("y9") + Range("y13") + Range("y17") + Range("y21") + Range("y25") + Range("y29") + Range("y30") + Range("y37") + Range("y41") + Range("y45")

Range("e2") = Range("z2") + Range("z6") + Range("z10") + Range("z14") + Range("z18") + Range("z22") + Range("z26") + Range("z30") + Range("z34") + Range("z38") + Range("z42")
Range("e3") = Range("z3") + Range("z7") + Range("z11") + Range("z15") + Range("z19") + Range("z23") + Range("z27") + Range("z30") + Range("z35") + Range("z39") + Range("z43")
Range("e4") = Range("z4") + Range("z8") + Range("z12") + Range("z16") + Range("z20") + Range("z24") + Range("z28") + Range("z30") + Range("z36") + Range("z40") + Range("z44")
Range("e5") = Range("z5") + Range("z9") + Range("z13") + Range("z17") + Range("z21") + Range("z25") + Range("z29") + Range("z30") + Range("z37") + Range("z41") + Range("z45")


For i = 2 To 5
For j = 2 To 5
If Cells(i, j) = 0 Then
Cells(i, j).ClearContents
End If
Next
Next

For i = 2 To 45
For j = 23 To 26
Cells(i, j).ClearContents
Next
Next

Columns("aa:zz").ClearContents


'feuil 2

a = Worksheets("NEW_VB_config").Range("o2:o12") 'nom des 11 feuilles
For i = 2 To 10000
  For f = 1 To 11                 'boucle sur les feuilles
    If a(f, 1) <> "" Then
      With Worksheets(a(f, 1))
        If .Range("n" & i).Value <> "" And .Range("a" & i).Value = ActiveSheet.Range("a7").Value Then
          For m = 1 To 4
            b(m) = Mid(.Range("n" & i), m, 1)
            If b(m) = 1 Or b(m) = 2 Or b(m) = 3 Or b(m) = 4 Then
              ActiveSheet.Range("aa" & i).Offset(0, 16 * (f - 1) + 4 * (m - 1) + b(m) - 1) = b(m)
              ActiveSheet.Range("w2").Offset(4 * (f - 1) + b(m) - 1, m - 1) = Application.Sum(ActiveSheet.Range("aa2").Offset(0, 16 * (f - 1) + 4 * (m - 1) + b(m) - 1).Resize(9999, 1)) / b(m)
            End If
          Next m
        End If
      End With
    End If
  Next f
Next i
Range("b8") = Range("w2") + Range("w6") + Range("w10") + Range("w14") + Range("w18") + Range("w22") + Range("w26") + Range("w30") + Range("w34") + Range("w38") + Range("w42")
Range("b9") = Range("w3") + Range("w7") + Range("w11") + Range("w15") + Range("w19") + Range("w23") + Range("w27") + Range("w31") + Range("w35") + Range("w39") + Range("w43")
Range("b10") = Range("w4") + Range("w8") + Range("w12") + Range("w16") + Range("w20") + Range("w24") + Range("w28") + Range("w32") + Range("w36") + Range("w40") + Range("w44")
Range("b11") = Range("w5") + Range("w9") + Range("w13") + Range("w17") + Range("w21") + Range("w25") + Range("w29") + Range("w33") + Range("w37") + Range("w41") + Range("w45")


Range("c8") = Range("x2") + Range("x6") + Range("x10") + Range("x14") + Range("x18") + Range("x22") + Range("x26") + Range("x30") + Range("x34") + Range("x38") + Range("x42")
Range("c9") = Range("x3") + Range("x7") + Range("x11") + Range("x15") + Range("x19") + Range("x23") + Range("x27") + Range("x30") + Range("x35") + Range("x39") + Range("x43")
Range("c10") = Range("x4") + Range("x8") + Range("x12") + Range("x16") + Range("x20") + Range("x24") + Range("x28") + Range("x30") + Range("x36") + Range("x40") + Range("x44")
Range("c11") = Range("x5") + Range("x9") + Range("x13") + Range("x17") + Range("x21") + Range("x25") + Range("x29") + Range("x30") + Range("x37") + Range("x41") + Range("x45")

Range("d8") = Range("y2") + Range("y6") + Range("y10") + Range("y14") + Range("y18") + Range("y22") + Range("y26") + Range("y30") + Range("y34") + Range("y38") + Range("y42")
Range("d9") = Range("y3") + Range("y7") + Range("y11") + Range("y15") + Range("y19") + Range("y23") + Range("y27") + Range("y30") + Range("y35") + Range("y39") + Range("y43")
Range("d10") = Range("y4") + Range("y8") + Range("y12") + Range("y16") + Range("y20") + Range("y24") + Range("y28") + Range("y30") + Range("y36") + Range("y40") + Range("y44")
Range("d11") = Range("y5") + Range("y9") + Range("y13") + Range("y17") + Range("y21") + Range("y25") + Range("y29") + Range("y30") + Range("y37") + Range("y41") + Range("y45")

Range("e8") = Range("z2") + Range("z6") + Range("z10") + Range("z14") + Range("z18") + Range("z22") + Range("z26") + Range("z30") + Range("z34") + Range("z38") + Range("z42")
Range("e9") = Range("z3") + Range("z7") + Range("z11") + Range("z15") + Range("z19") + Range("z23") + Range("z27") + Range("z30") + Range("z35") + Range("z39") + Range("z43")
Range("e10") = Range("z4") + Range("z8") + Range("z12") + Range("z16") + Range("z20") + Range("z24") + Range("z28") + Range("z30") + Range("z36") + Range("z40") + Range("z44")
Range("e11") = Range("z5") + Range("z9") + Range("z13") + Range("z17") + Range("z21") + Range("z25") + Range("z29") + Range("z30") + Range("z37") + Range("z41") + Range("z45")


For i = 8 To 11
For j = 2 To 5
If Cells(i, j) = 0 Then
Cells(i, j).ClearContents
End If
Next
Next

For i = 2 To 45
For j = 23 To 26
Cells(i, j).ClearContents
Next
Next

Columns("aa:zz").ClearContents


'projet 3

a = Worksheets("NEW_VB_config").Range("o2:o12") 'nom des 11 feuilles
For i = 2 To 10000
  For f = 1 To 11                 'boucle sur les feuilles
    If a(f, 1) <> "" Then
      With Worksheets(a(f, 1))
        If .Range("n" & i).Value <> "" And .Range("a" & i).Value = ActiveSheet.Range("a13").Value Then
          For m = 1 To 4
            b(m) = Mid(.Range("n" & i), m, 1)
            If b(m) = 1 Or b(m) = 2 Or b(m) = 3 Or b(m) = 4 Then
              ActiveSheet.Range("aa" & i).Offset(0, 16 * (f - 1) + 4 * (m - 1) + b(m) - 1) = b(m)
              ActiveSheet.Range("w2").Offset(4 * (f - 1) + b(m) - 1, m - 1) = Application.Sum(ActiveSheet.Range("aa2").Offset(0, 16 * (f - 1) + 4 * (m - 1) + b(m) - 1).Resize(9999, 1)) / b(m)
            End If
          Next m
        End If
      End With
    End If
  Next f
Next i
Range("b14") = Range("w2") + Range("w6") + Range("w10") + Range("w14") + Range("w18") + Range("w22") + Range("w26") + Range("w30") + Range("w34") + Range("w38") + Range("w42")
Range("b15") = Range("w3") + Range("w7") + Range("w11") + Range("w15") + Range("w19") + Range("w23") + Range("w27") + Range("w31") + Range("w35") + Range("w39") + Range("w43")
Range("b16") = Range("w4") + Range("w8") + Range("w12") + Range("w16") + Range("w20") + Range("w24") + Range("w28") + Range("w32") + Range("w36") + Range("w40") + Range("w44")
Range("b17") = Range("w5") + Range("w9") + Range("w13") + Range("w17") + Range("w21") + Range("w25") + Range("w29") + Range("w33") + Range("w37") + Range("w41") + Range("w45")


Range("c14") = Range("x2") + Range("x6") + Range("x10") + Range("x14") + Range("x18") + Range("x22") + Range("x26") + Range("x30") + Range("x34") + Range("x38") + Range("x42")
Range("c15") = Range("x3") + Range("x7") + Range("x11") + Range("x15") + Range("x19") + Range("x23") + Range("x27") + Range("x30") + Range("x35") + Range("x39") + Range("x43")
Range("c16") = Range("x4") + Range("x8") + Range("x12") + Range("x16") + Range("x20") + Range("x24") + Range("x28") + Range("x30") + Range("x36") + Range("x40") + Range("x44")
Range("c17") = Range("x5") + Range("x9") + Range("x13") + Range("x17") + Range("x21") + Range("x25") + Range("x29") + Range("x30") + Range("x37") + Range("x41") + Range("x45")

Range("d14") = Range("y2") + Range("y6") + Range("y10") + Range("y14") + Range("y18") + Range("y22") + Range("y26") + Range("y30") + Range("y34") + Range("y38") + Range("y42")
Range("d15") = Range("y3") + Range("y7") + Range("y11") + Range("y15") + Range("y19") + Range("y23") + Range("y27") + Range("y30") + Range("y35") + Range("y39") + Range("y43")
Range("d16") = Range("y4") + Range("y8") + Range("y12") + Range("y16") + Range("y20") + Range("y24") + Range("y28") + Range("y30") + Range("y36") + Range("y40") + Range("y44")
Range("d17") = Range("y5") + Range("y9") + Range("y13") + Range("y17") + Range("y21") + Range("y25") + Range("y29") + Range("y30") + Range("y37") + Range("y41") + Range("y45")

Range("e14") = Range("z2") + Range("z6") + Range("z10") + Range("z14") + Range("z18") + Range("z22") + Range("z26") + Range("z30") + Range("z34") + Range("z38") + Range("z42")
Range("e15") = Range("z3") + Range("z7") + Range("z11") + Range("z15") + Range("z19") + Range("z23") + Range("z27") + Range("z30") + Range("z35") + Range("z39") + Range("z43")
Range("e16") = Range("z4") + Range("z8") + Range("z12") + Range("z16") + Range("z20") + Range("z24") + Range("z28") + Range("z30") + Range("z36") + Range("z40") + Range("z44")
Range("e17") = Range("z5") + Range("z9") + Range("z13") + Range("z17") + Range("z21") + Range("z25") + Range("z29") + Range("z30") + Range("z37") + Range("z41") + Range("z45")


For i = 14 To 17
For j = 2 To 5
If Cells(i, j) = 0 Then
Cells(i, j).ClearContents
End If
Next
Next

For i = 2 To 45
For j = 23 To 26
Cells(i, j).ClearContents
Next
Next

Columns("aa:zz").ClearContents



'projet 4
a = Worksheets("NEW_VB_config").Range("o2:o12") 'nom des 11 feuilles
For i = 2 To 10000
  For f = 1 To 11                 'boucle sur les feuilles
    If a(f, 1) <> "" Then
      With Worksheets(a(f, 1))
        If .Range("n" & i).Value <> "" And .Range("a" & i).Value = ActiveSheet.Range("a19").Value Then
          For m = 1 To 4
            b(m) = Mid(.Range("n" & i), m, 1)
            If b(m) = 1 Or b(m) = 2 Or b(m) = 3 Or b(m) = 4 Then
              ActiveSheet.Range("aa" & i).Offset(0, 16 * (f - 1) + 4 * (m - 1) + b(m) - 1) = b(m)
              ActiveSheet.Range("w2").Offset(4 * (f - 1) + b(m) - 1, m - 1) = Application.Sum(ActiveSheet.Range("aa2").Offset(0, 16 * (f - 1) + 4 * (m - 1) + b(m) - 1).Resize(9999, 1)) / b(m)
            End If
          Next m
        End If
      End With
    End If
  Next f
Next i
Range("b20") = Range("w2") + Range("w6") + Range("w10") + Range("w14") + Range("w18") + Range("w22") + Range("w26") + Range("w30") + Range("w34") + Range("w38") + Range("w42")
Range("b21") = Range("w3") + Range("w7") + Range("w11") + Range("w15") + Range("w19") + Range("w23") + Range("w27") + Range("w31") + Range("w35") + Range("w39") + Range("w43")
Range("b22") = Range("w4") + Range("w8") + Range("w12") + Range("w16") + Range("w20") + Range("w24") + Range("w28") + Range("w32") + Range("w36") + Range("w40") + Range("w44")
Range("b23") = Range("w5") + Range("w9") + Range("w13") + Range("w17") + Range("w21") + Range("w25") + Range("w29") + Range("w33") + Range("w37") + Range("w41") + Range("w45")


Range("c20") = Range("x2") + Range("x6") + Range("x10") + Range("x14") + Range("x18") + Range("x22") + Range("x26") + Range("x30") + Range("x34") + Range("x38") + Range("x42")
Range("c21") = Range("x3") + Range("x7") + Range("x11") + Range("x15") + Range("x19") + Range("x23") + Range("x27") + Range("x30") + Range("x35") + Range("x39") + Range("x43")
Range("c22") = Range("x4") + Range("x8") + Range("x12") + Range("x16") + Range("x20") + Range("x24") + Range("x28") + Range("x30") + Range("x36") + Range("x40") + Range("x44")
Range("c23") = Range("x5") + Range("x9") + Range("x13") + Range("x17") + Range("x21") + Range("x25") + Range("x29") + Range("x30") + Range("x37") + Range("x41") + Range("x45")

Range("d20") = Range("y2") + Range("y6") + Range("y10") + Range("y14") + Range("y18") + Range("y22") + Range("y26") + Range("y30") + Range("y34") + Range("y38") + Range("y42")
Range("d21") = Range("y3") + Range("y7") + Range("y11") + Range("y15") + Range("y19") + Range("y23") + Range("y27") + Range("y30") + Range("y35") + Range("y39") + Range("y43")
Range("d22") = Range("y4") + Range("y8") + Range("y12") + Range("y16") + Range("y20") + Range("y24") + Range("y28") + Range("y30") + Range("y36") + Range("y40") + Range("y44")
Range("d23") = Range("y5") + Range("y9") + Range("y13") + Range("y17") + Range("y21") + Range("y25") + Range("y29") + Range("y30") + Range("y37") + Range("y41") + Range("y45")

Range("e20") = Range("z2") + Range("z6") + Range("z10") + Range("z14") + Range("z18") + Range("z22") + Range("z26") + Range("z30") + Range("z34") + Range("z38") + Range("z42")
Range("e21") = Range("z3") + Range("z7") + Range("z11") + Range("z15") + Range("z19") + Range("z23") + Range("z27") + Range("z30") + Range("z35") + Range("z39") + Range("z43")
Range("e22") = Range("z4") + Range("z8") + Range("z12") + Range("z16") + Range("z20") + Range("z24") + Range("z28") + Range("z30") + Range("z36") + Range("z40") + Range("z44")
Range("e23") = Range("z5") + Range("z9") + Range("z13") + Range("z17") + Range("z21") + Range("z25") + Range("z29") + Range("z30") + Range("z37") + Range("z41") + Range("z45")


For i = 20 To 23
For j = 2 To 5
If Cells(i, j) = 0 Then
Cells(i, j).ClearContents
End If
Next
Next

For i = 2 To 45
For j = 23 To 26
Cells(i, j).ClearContents
Next
Next

Columns("aa:zz").ClearContents

'projet 5
a = Worksheets("NEW_VB_config").Range("o2:o12") 'nom des 11 feuilles
For i = 2 To 10000
  For f = 1 To 11                 'boucle sur les feuilles
    If a(f, 1) <> "" Then
      With Worksheets(a(f, 1))
        If .Range("n" & i).Value <> "" And .Range("a" & i).Value = ActiveSheet.Range("a25").Value Then
          For m = 1 To 4
            b(m) = Mid(.Range("n" & i), m, 1)
            If b(m) = 1 Or b(m) = 2 Or b(m) = 3 Or b(m) = 4 Then
              ActiveSheet.Range("aa" & i).Offset(0, 16 * (f - 1) + 4 * (m - 1) + b(m) - 1) = b(m)
              ActiveSheet.Range("w2").Offset(4 * (f - 1) + b(m) - 1, m - 1) = Application.Sum(ActiveSheet.Range("aa2").Offset(0, 16 * (f - 1) + 4 * (m - 1) + b(m) - 1).Resize(9999, 1)) / b(m)
            End If
          Next m
        End If
      End With
    End If
  Next f
Next i
Range("b26") = Range("w2") + Range("w6") + Range("w10") + Range("w14") + Range("w18") + Range("w22") + Range("w26") + Range("w30") + Range("w34") + Range("w38") + Range("w42")
Range("b27") = Range("w3") + Range("w7") + Range("w11") + Range("w15") + Range("w19") + Range("w23") + Range("w27") + Range("w31") + Range("w35") + Range("w39") + Range("w43")
Range("b28") = Range("w4") + Range("w8") + Range("w12") + Range("w16") + Range("w20") + Range("w24") + Range("w28") + Range("w32") + Range("w36") + Range("w40") + Range("w44")
Range("b29") = Range("w5") + Range("w9") + Range("w13") + Range("w17") + Range("w21") + Range("w25") + Range("w29") + Range("w33") + Range("w37") + Range("w41") + Range("w45")


Range("c26") = Range("x2") + Range("x6") + Range("x10") + Range("x14") + Range("x18") + Range("x22") + Range("x26") + Range("x30") + Range("x34") + Range("x38") + Range("x42")
Range("c27") = Range("x3") + Range("x7") + Range("x11") + Range("x15") + Range("x19") + Range("x23") + Range("x27") + Range("x30") + Range("x35") + Range("x39") + Range("x43")
Range("c28") = Range("x4") + Range("x8") + Range("x12") + Range("x16") + Range("x20") + Range("x24") + Range("x28") + Range("x30") + Range("x36") + Range("x40") + Range("x44")
Range("c29") = Range("x5") + Range("x9") + Range("x13") + Range("x17") + Range("x21") + Range("x25") + Range("x29") + Range("x30") + Range("x37") + Range("x41") + Range("x45")

Range("d26") = Range("y2") + Range("y6") + Range("y10") + Range("y14") + Range("y18") + Range("y22") + Range("y26") + Range("y30") + Range("y34") + Range("y38") + Range("y42")
Range("d27") = Range("y3") + Range("y7") + Range("y11") + Range("y15") + Range("y19") + Range("y23") + Range("y27") + Range("y30") + Range("y35") + Range("y39") + Range("y43")
Range("d28") = Range("y4") + Range("y8") + Range("y12") + Range("y16") + Range("y20") + Range("y24") + Range("y28") + Range("y30") + Range("y36") + Range("y40") + Range("y44")
Range("d29") = Range("y5") + Range("y9") + Range("y13") + Range("y17") + Range("y21") + Range("y25") + Range("y29") + Range("y30") + Range("y37") + Range("y41") + Range("y45")

Range("e26") = Range("z2") + Range("z6") + Range("z10") + Range("z14") + Range("z18") + Range("z22") + Range("z26") + Range("z30") + Range("z34") + Range("z38") + Range("z42")
Range("e27") = Range("z3") + Range("z7") + Range("z11") + Range("z15") + Range("z19") + Range("z23") + Range("z27") + Range("z30") + Range("z35") + Range("z39") + Range("z43")
Range("e28") = Range("z4") + Range("z8") + Range("z12") + Range("z16") + Range("z20") + Range("z24") + Range("z28") + Range("z30") + Range("z36") + Range("z40") + Range("z44")
Range("e29") = Range("z5") + Range("z9") + Range("z13") + Range("z17") + Range("z21") + Range("z25") + Range("z29") + Range("z30") + Range("z37") + Range("z41") + Range("z45")


For i = 26 To 29
For j = 2 To 5
If Cells(i, j) = 0 Then
Cells(i, j).ClearContents
End If
Next
Next

For i = 2 To 45
For j = 23 To 26
Cells(i, j).ClearContents
Next
Next

Columns("aa:zz").ClearContents

'projet 6
a = Worksheets("NEW_VB_config").Range("o2:o12") 'nom des 11 feuilles
For i = 2 To 10000
  For f = 1 To 11                 'boucle sur les feuilles
    If a(f, 1) <> "" Then
      With Worksheets(a(f, 1))
        If .Range("n" & i).Value <> "" And .Range("a" & i).Value = ActiveSheet.Range("a31").Value Then
          For m = 1 To 4
            b(m) = Mid(.Range("n" & i), m, 1)
            If b(m) = 1 Or b(m) = 2 Or b(m) = 3 Or b(m) = 4 Then
              ActiveSheet.Range("aa" & i).Offset(0, 16 * (f - 1) + 4 * (m - 1) + b(m) - 1) = b(m)
              ActiveSheet.Range("w2").Offset(4 * (f - 1) + b(m) - 1, m - 1) = Application.Sum(ActiveSheet.Range("aa2").Offset(0, 16 * (f - 1) + 4 * (m - 1) + b(m) - 1).Resize(9999, 1)) / b(m)
            End If
          Next m
        End If
      End With
    End If
  Next f
Next i
Range("b31") = Range("w2") + Range("w6") + Range("w10") + Range("w14") + Range("w18") + Range("w22") + Range("w26") + Range("w30") + Range("w34") + Range("w38") + Range("w42")
Range("b32") = Range("w3") + Range("w7") + Range("w11") + Range("w15") + Range("w19") + Range("w23") + Range("w27") + Range("w31") + Range("w35") + Range("w39") + Range("w43")
Range("b33") = Range("w4") + Range("w8") + Range("w12") + Range("w16") + Range("w20") + Range("w24") + Range("w28") + Range("w32") + Range("w36") + Range("w40") + Range("w44")
Range("b34") = Range("w5") + Range("w9") + Range("w13") + Range("w17") + Range("w21") + Range("w25") + Range("w29") + Range("w33") + Range("w37") + Range("w41") + Range("w45")


Range("c31") = Range("x2") + Range("x6") + Range("x10") + Range("x14") + Range("x18") + Range("x22") + Range("x26") + Range("x30") + Range("x34") + Range("x38") + Range("x42")
Range("c32") = Range("x3") + Range("x7") + Range("x11") + Range("x15") + Range("x19") + Range("x23") + Range("x27") + Range("x30") + Range("x35") + Range("x39") + Range("x43")
Range("c33") = Range("x4") + Range("x8") + Range("x12") + Range("x16") + Range("x20") + Range("x24") + Range("x28") + Range("x30") + Range("x36") + Range("x40") + Range("x44")
Range("c34") = Range("x5") + Range("x9") + Range("x13") + Range("x17") + Range("x21") + Range("x25") + Range("x29") + Range("x30") + Range("x37") + Range("x41") + Range("x45")

Range("d31") = Range("y2") + Range("y6") + Range("y10") + Range("y14") + Range("y18") + Range("y22") + Range("y26") + Range("y30") + Range("y34") + Range("y38") + Range("y42")
Range("d32") = Range("y3") + Range("y7") + Range("y11") + Range("y15") + Range("y19") + Range("y23") + Range("y27") + Range("y30") + Range("y35") + Range("y39") + Range("y43")
Range("d33") = Range("y4") + Range("y8") + Range("y12") + Range("y16") + Range("y20") + Range("y24") + Range("y28") + Range("y30") + Range("y36") + Range("y40") + Range("y44")
Range("d34") = Range("y5") + Range("y9") + Range("y13") + Range("y17") + Range("y21") + Range("y25") + Range("y29") + Range("y30") + Range("y37") + Range("y41") + Range("y45")

Range("e31") = Range("z2") + Range("z6") + Range("z10") + Range("z14") + Range("z18") + Range("z22") + Range("z26") + Range("z30") + Range("z34") + Range("z38") + Range("z42")
Range("e32") = Range("z3") + Range("z7") + Range("z11") + Range("z15") + Range("z19") + Range("z23") + Range("z27") + Range("z30") + Range("z35") + Range("z39") + Range("z43")
Range("e33") = Range("z4") + Range("z8") + Range("z12") + Range("z16") + Range("z20") + Range("z24") + Range("z28") + Range("z30") + Range("z36") + Range("z40") + Range("z44")
Range("e34") = Range("z5") + Range("z9") + Range("z13") + Range("z17") + Range("z21") + Range("z25") + Range("z29") + Range("z30") + Range("z37") + Range("z41") + Range("z45")


For i = 32 To 35
For j = 2 To 5
If Cells(i, j) = 0 Then
Cells(i, j).ClearContents
End If
Next
Next

For i = 2 To 45
For j = 23 To 26
Cells(i, j).ClearContents
Next
Next

Columns("aa:zz").ClearContents

'projet 7
a = Worksheets("NEW_VB_config").Range("o2:o12") 'nom des 11 feuilles
For i = 2 To 10000
  For f = 1 To 11                 'boucle sur les feuilles
    If a(f, 1) <> "" Then
      With Worksheets(a(f, 1))
        If .Range("n" & i).Value <> "" And .Range("a" & i).Value = ActiveSheet.Range("a37").Value Then
          For m = 1 To 4
            b(m) = Mid(.Range("n" & i), m, 1)
            If b(m) = 1 Or b(m) = 2 Or b(m) = 3 Or b(m) = 4 Then
              ActiveSheet.Range("aa" & i).Offset(0, 16 * (f - 1) + 4 * (m - 1) + b(m) - 1) = b(m)
              ActiveSheet.Range("w2").Offset(4 * (f - 1) + b(m) - 1, m - 1) = Application.Sum(ActiveSheet.Range("aa2").Offset(0, 16 * (f - 1) + 4 * (m - 1) + b(m) - 1).Resize(9999, 1)) / b(m)
            End If
          Next m
        End If
      End With
    End If
  Next f
Next i
Range("b38") = Range("w2") + Range("w6") + Range("w10") + Range("w14") + Range("w18") + Range("w22") + Range("w26") + Range("w30") + Range("w34") + Range("w38") + Range("w42")
Range("b39") = Range("w3") + Range("w7") + Range("w11") + Range("w15") + Range("w19") + Range("w23") + Range("w27") + Range("w31") + Range("w35") + Range("w39") + Range("w43")
Range("b40") = Range("w4") + Range("w8") + Range("w12") + Range("w16") + Range("w20") + Range("w24") + Range("w28") + Range("w32") + Range("w36") + Range("w40") + Range("w44")
Range("b41") = Range("w5") + Range("w9") + Range("w13") + Range("w17") + Range("w21") + Range("w25") + Range("w29") + Range("w33") + Range("w37") + Range("w41") + Range("w45")


Range("c38") = Range("x2") + Range("x6") + Range("x10") + Range("x14") + Range("x18") + Range("x22") + Range("x26") + Range("x30") + Range("x34") + Range("x38") + Range("x42")
Range("c39") = Range("x3") + Range("x7") + Range("x11") + Range("x15") + Range("x19") + Range("x23") + Range("x27") + Range("x30") + Range("x35") + Range("x39") + Range("x43")
Range("c40") = Range("x4") + Range("x8") + Range("x12") + Range("x16") + Range("x20") + Range("x24") + Range("x28") + Range("x30") + Range("x36") + Range("x40") + Range("x44")
Range("c41") = Range("x5") + Range("x9") + Range("x13") + Range("x17") + Range("x21") + Range("x25") + Range("x29") + Range("x30") + Range("x37") + Range("x41") + Range("x45")

Range("d38") = Range("y2") + Range("y6") + Range("y10") + Range("y14") + Range("y18") + Range("y22") + Range("y26") + Range("y30") + Range("y34") + Range("y38") + Range("y42")
Range("d39") = Range("y3") + Range("y7") + Range("y11") + Range("y15") + Range("y19") + Range("y23") + Range("y27") + Range("y30") + Range("y35") + Range("y39") + Range("y43")
Range("d40") = Range("y4") + Range("y8") + Range("y12") + Range("y16") + Range("y20") + Range("y24") + Range("y28") + Range("y30") + Range("y36") + Range("y40") + Range("y44")
Range("d41") = Range("y5") + Range("y9") + Range("y13") + Range("y17") + Range("y21") + Range("y25") + Range("y29") + Range("y30") + Range("y37") + Range("y41") + Range("y45")

Range("e38") = Range("z2") + Range("z6") + Range("z10") + Range("z14") + Range("z18") + Range("z22") + Range("z26") + Range("z30") + Range("z34") + Range("z38") + Range("z42")
Range("e39") = Range("z3") + Range("z7") + Range("z11") + Range("z15") + Range("z19") + Range("z23") + Range("z27") + Range("z30") + Range("z35") + Range("z39") + Range("z43")
Range("e40") = Range("z4") + Range("z8") + Range("z12") + Range("z16") + Range("z20") + Range("z24") + Range("z28") + Range("z30") + Range("z36") + Range("z40") + Range("z44")
Range("e41") = Range("z5") + Range("z9") + Range("z13") + Range("z17") + Range("z21") + Range("z25") + Range("z29") + Range("z30") + Range("z37") + Range("z41") + Range("z45")


For i = 38 To 41
For j = 2 To 5
If Cells(i, j) = 0 Then
Cells(i, j).ClearContents
End If
Next
Next

For i = 2 To 45
For j = 23 To 26
Cells(i, j).ClearContents
Next
Next

Columns("aa:zz").ClearContents








End Sub

jusqu a ici c marche bien
le probleme je ne peux pas rajouter une autre procedure a partir range("a37") ca maffiche erreur " procedure trop grande"
alors que mois je doisle faire aussi pour range("43") range("49"), range'"55") , range("61")

je ne sais pas comment y proceder

si vous avez une idee merci de maider

Effectuez une recherche sur Excel Downloads...

BOUCLE pour alléger le code

BIL boud

XLDnaute Occasionnel

Staple1600

XLDnaute Barbatruc

BIL boud

XLDnaute Occasionnel

Pièces jointes

BIL boud

XLDnaute Occasionnel

BIL boud

XLDnaute Occasionnel

Staple1600

XLDnaute Barbatruc

ODVJ

XLDnaute Impliqué

ODVJ

XLDnaute Impliqué

BIL boud

XLDnaute Occasionnel

BIL boud

XLDnaute Occasionnel

BIL boud

XLDnaute Occasionnel

Discussions similaires

Membres actuellement en ligne

Partager cette page

Tutos vidéos

Statistiques des forums