macro (boucle)

Bonjour à tous le forum !!!

J'ai un petit problème de macro les dernières combinaisons de celle ci ne s'exécute pa, est-ce que qqun pourrait jeter un coup d'oeil parce que je n'arrive décidemment pa a résoudre mon pb
(y a t-il trop de boucle ??? Est ce un pb de longueur ???, ...)
Notamment à partir de If Range ('H19') =

Merci beaucoup par avance (-:

Cordialement



Sub combinaison()

Dim WS As Variant

If Range('h12') <> 'x' Then
For Each WS In Worksheets
WS.Rows('153:153').Delete Shift:=xlUp
Next WS
End If

If Range('b25') = 'x' Then
For Each WS In Worksheets
WS.Rows('147:147').Delete Shift:=xlUp
Next WS
End If

If Range('b24') = 'x' Then
For Each WS In Worksheets
WS.Rows('151:152').Delete Shift:=xlUp
Next WS
End If

If Range('b23') = 'x' Then
For Each WS In Worksheets
WS.Rows('143:152').Delete Shift:=xlUp
Next WS
End If

If Range('b22') = 'x' Then
For Each WS In Worksheets
WS.Rows('137:137').Delete Shift:=xlUp
Next WS
End If

If Range('b21') = 'x' Then
For Each WS In Worksheets
WS.Rows('141:142').Delete Shift:=xlUp
Next WS
End If

If Range('b20') = 'x' Then
For Each WS In Worksheets
WS.Rows('133:142').Delete Shift:=xlUp
Next WS
End If

If Range('b19') = 'x' Then
For Each WS In Worksheets
WS.Rows('121:123').Delete Shift:=xlUp
Next WS
End If

If Range('h8') <> 'x' Then
For Each WS In Worksheets
WS.Rows('126:126').Delete Shift:=xlUp
Next WS
End If

If Range('b18') = 'x' Then
For Each WS In Worksheets
WS.Rows('124:124').Delete Shift:=xlUp
Next WS
End If

If Range('b18') = 'x' Then
For Each WS In Worksheets
WS.Rows('121:122').Delete Shift:=xlUp
Next WS
End If

If Range('b17') = 'x' Then
For Each WS In Worksheets
WS.Rows('123:124').Delete Shift:=xlUp
Next WS
End If

If Range('b17') = 'x' Then
For Each WS In Worksheets
WS.Rows('121:121').Delete Shift:=xlUp
Next WS
End If

If Range('b16') = 'x' Then
For Each WS In Worksheets
WS.Rows('122:124').Delete Shift:=xlUp
Next WS
End If

If Range('b15') = 'x' Then
For Each WS In Worksheets
WS.Rows('121:124').Delete Shift:=xlUp
Next WS
End If

If Range('b14') = 'x' Then
For Each WS In Worksheets
WS.Rows('94:95').Delete Shift:=xlUp
Next WS
End If

If Range('b13') = 'x' Then
For Each WS In Worksheets
WS.Rows('92:93').Delete Shift:=xlUp
Next WS
End If

If Range('b12') = 'x' Then
For Each WS In Worksheets
WS.Rows('91:119').Delete Shift:=xlUp
Next WS
End If

If Range('b11') = 'x' Then
For Each WS In Worksheets
WS.Rows('87:88').Delete Shift:=xlUp
Next WS
End If

If Range('b10') = 'x' Then
For Each WS In Worksheets
WS.Rows('89:90').Delete Shift:=xlUp
Next WS
End If

If Range('h10') <> 'x' Then
For Each WS In Worksheets
WS.Rows('78:78').Delete Shift:=xlUp
Next WS
End If

If Range('h18') = '16' Then
For Each WS In Worksheets
WS.Rows('74:75').Delete Shift:=xlUp
Next WS
End If

If Range('h18') = '14' Then
For Each WS In Worksheets
WS.Rows('72:75').Delete Shift:=xlUp
Next WS
End If

If Range('h18') = '12' Then
For Each WS In Worksheets
WS.Rows('70:75').Delete Shift:=xlUp
Next WS
End If

If Range('h18') = '10' Then
For Each WS In Worksheets
WS.Rows('68:75').Delete Shift:=xlUp
Next WS
End If

If Range('h18') = '8' Then
For Each WS In Worksheets
WS.Rows('66:75').Delete Shift:=xlUp
Next WS
End If

If Range('h18') = '6' Then
For Each WS In Worksheets
WS.Rows('64:75').Delete Shift:=xlUp
Next WS
End If

If Range('h18') = '4' Then
For Each WS In Worksheets
WS.Rows('62:75').Delete Shift:=xlUp
Next WS
End If

If Range('h18') = '2' Then
For Each WS In Worksheets
WS.Rows('60:75').Delete Shift:=xlUp
Next WS
End If

If Range('h18') = '0' Then
For Each WS In Worksheets
WS.Rows('58:75').Delete Shift:=xlUp
Next WS
End If

If Range('b9') = 'x' Then
For Each WS In Worksheets
WS.Rows('56:57').Delete Shift:=xlUp
Next WS
End If

If Range('b9') = 'x' Then
For Each WS In Worksheets
WS.Rows('52:53').Delete Shift:=xlUp
Next WS
End If

If Range('b8') = 'x' Then
For Each WS In Worksheets
WS.Rows('54:57').Delete Shift:=xlUp
Next WS
End If

If Range('b7') = 'x' Then
For Each WS In Worksheets
WS.Rows('52:55').Delete Shift:=xlUp
Next WS
End If

If Range('H6') <> 'x' Then
For Each WS In Worksheets
WS.Rows('49:49').Delete Shift:=xlUp
Next WS
End If

If Range('H5') <> 'x' Then
For Each WS In Worksheets
WS.Rows('48:48').Delete Shift:=xlUp
Next WS
End If

If Range('H4') <> 'x' Then
For Each WS In Worksheets
WS.Rows('47:47').Delete Shift:=xlUp
Next WS
End If

If Range('b5') = 'x' Then
Range('C31').Select
Selection.Interior.ColorIndex = xlNone
Range('C32').Select
Selection.Interior.ColorIndex = xlNone
Range('C42').Select
Selection.Interior.ColorIndex = xlNone
Range('C43').Select
Selection.Interior.ColorIndex = xlNone
Range('C44').Select
Selection.Interior.ColorIndex = xlNone
Range('C45').Select
Selection.Interior.ColorIndex = xlNone
Range('C46').Select
Selection.Interior.ColorIndex = xlNone
End If

If Range('b5') = 'x' Then
For Each WS In Worksheets
WS.Rows('37:41').Delete Shift:=xlUp
Next WS
End If

If Range('b4') = 'x' Then
For Each WS In Worksheets
WS.Rows('37:41').Delete Shift:=xlUp
Next WS
End If

If Range('h9') <> 'x' Then
For Each WS In Worksheets
WS.Rows('30:30').Delete Shift:=xlUp
Next WS
End If

If Range('h7') <> 'x' Then
For ligne = 1 To [A65000].End(xlUp).Row
If Cells(ligne, 1) = [E7] Then
For Each WS In Worksheets
WS.Rows(ligne).Delete
Next WS
End If
Next
End If

If Range('h11') <> 'x' Then
For ligne = 1 To [A65000].End(xlUp).Row
If Cells(ligne, 1) = [E11] Then
For Each WS In Worksheets
WS.Rows(ligne).Delete
Next WS
End If
Next
End If

If Range('h15') <= '6' Then
For ligne = 1 To [A65000].End(xlUp).Row
If Cells(ligne, 1) = 'PL7' Then
For Each WS In Worksheets
WS.Rows(ligne).Delete
Next WS
End If
Next
End If

If Range('h15') <= '5' Then
For ligne = 1 To [A65000].End(xlUp).Row
If Cells(ligne, 1) = 'PL6' Then
For Each WS In Worksheets
WS.Rows(ligne).Delete
Next WS
End If
Next
End If

If Range('h15') <= '4' Then
For ligne = 1 To [A65000].End(xlUp).Row
If Cells(ligne, 1) = 'PL5' Then
For Each WS In Worksheets
WS.Rows(ligne).Delete
Next WS
End If
Next
End If

If Range('h15') <= '3' Then
For ligne = 1 To [A65000].End(xlUp).Row
If Cells(ligne, 1) = 'PL4' Then
For Each WS In Worksheets
WS.Rows(ligne).Delete
Next WS
End If
Next
End If

If Range('h15') <= '2' Then
For ligne = 1 To [A65000].End(xlUp).Row
If Cells(ligne, 1) = 'PL3' Then
For Each WS In Worksheets
WS.Rows(ligne).Delete
Next WS
End If
Next
End If

If Range('h15') <= '1' Then
For ligne = 1 To [A65000].End(xlUp).Row
If Cells(ligne, 1) = 'PL2' Then
For Each WS In Worksheets
WS.Rows(ligne).Delete
Next WS
End If
Next
End If

If Range('h15') <= '0' Then
For ligne = 1 To [A65000].End(xlUp).Row
If Cells(ligne, 1) = 'PL1' Then
For Each WS In Worksheets
WS.Rows(ligne).Delete
Next WS
End If
Next
End If

If Range('h16') <= '3' Then
For ligne = 1 To [A65000].End(xlUp).Row
If Cells(ligne, 1) = 'Insert 4 PL2A' Then
For Each WS In Worksheets
WS.Rows(ligne).Delete
Next WS
End If
Next
End If

If Range('h16') <= '2' Then
For ligne = 1 To [A65000].End(xlUp).Row
If Cells(ligne, 1) = 'Insert 3 PL2A' Then
For Each WS In Worksheets
WS.Rows(ligne).Delete
Next WS
End If
Next
End If

If Range('h16') <= '1' Then
For ligne = 1 To [A65000].End(xlUp).Row
If Cells(ligne, 1) = 'Insert 2 PL2A' Then
For Each WS In Worksheets
WS.Rows(ligne).Delete
Next WS
End If
Next
End If

If Range('h16') <= '0' Then
For ligne = 1 To [A65000].End(xlUp).Row
If Cells(ligne, 1) = 'Insert 1 PL2A' Then
For Each WS In Worksheets
WS.Rows(ligne).Delete
Next WS
End If
Next
End If

If Range('h17') <= '3' Then
For ligne = 1 To [A65000].End(xlUp).Row
If Cells(ligne, 1) = 'Insert 4 PL2B' Then
For Each WS In Worksheets
WS.Rows(ligne).Delete
Next WS
End If
Next
End If

If Range('h17') <= '2' Then
For ligne = 1 To [A65000].End(xlUp).Row
If Cells(ligne, 1) = 'Insert 3 PL2B' Then
For Each WS In Worksheets
WS.Rows(ligne).Delete
Next WS
End If
Next
End If

If Range('h17') <= '1' Then
For ligne = 1 To [A65000].End(xlUp).Row
If Cells(ligne, 1) = 'Insert 2 PL2B' Then
For Each WS In Worksheets
WS.Rows(ligne).Delete
Next WS
End If
Next
End If

If Range('h17') <= '0' Then
For ligne = 1 To [A65000].End(xlUp).Row
If Cells(ligne, 1) = 'Insert 1 PL2B' Then
For Each WS In Worksheets
WS.Rows(ligne).Delete
Next WS
End If
Next
End If

If Range('h19') = '16' Then
For ligne = 1 To [A65000].End(xlUp).Row
If Cells(ligne, 1) = 'Barrettes 1.2 E ARR' Then
For Each WS In Worksheets
WS.Rows(ligne).Delete
Next WS
End If
Next
End If


If Range('h19') = '14' Then
For ligne = 1 To [A65000].End(xlUp).Row
If Cells(ligne, 1) = 'Barrettes 1.2 D ARR' Then
For Each WS In Worksheets
WS.Rows(ligne).Delete
Next WS
End If
Next
End If


If Range('h19') = '12' Then
For ligne = 1 To [A65000].End(xlUp).Row
If Cells(ligne, 1) = 'Barrettes 1.2 C ARR' Then
For Each WS In Worksheets
WS.Rows(ligne).Delete
Next WS
End If
Next
End If


If Range('h19') = '10' Then
For ligne = 1 To [A65000].End(xlUp).Row
If Cells(ligne, 1) = 'Barrettes 1.1 H AVT' Then
For Each WS In Worksheets
WS.Rows(ligne).Delete
Next WS
End If
Next
End If


If Range('h19') = '8' Then
For ligne = 1 To [A65000].End(xlUp).Row
If Cells(ligne, 1) = 'Barrettes 1.1 G AVT' Then
For Each WS In Worksheets
WS.Rows(ligne).Delete
Next WS
End If
Next
End If


If Range('h19') = '6' Then
For ligne = 1 To [A65000].End(xlUp).Row
If Cells(ligne, 1) = 'Barrettes 1.1 F AVT' Then
For Each WS In Worksheets
WS.Rows(ligne).Delete
Next WS
End If
Next
End If


If Range('h19') = '4' Then
For ligne = 1 To [A65000].End(xlUp).Row
If Cells(ligne, 1) = 'Barrettes 1.1 E ARR' Then
For Each WS In Worksheets
WS.Rows(ligne).Delete
Next WS
End If
Next
End If


If Range('h19') = '2' Then
For ligne = 1 To [A65000].End(xlUp).Row
If Cells(ligne, 1) = 'Barrettes 1.1 D ARR' Then
For Each WS In Worksheets
WS.Rows(ligne).Delete
Next WS
End If
Next
End If

If Range('h19') = '0' Then
For ligne = 1 To [A65000].End(xlUp).Row
If Cells(ligne, 1) = 'Barrettes 1.1 C ARR' Then
For Each WS In Worksheets
WS.Rows(ligne).Delete
Next WS
End If
Next
End If

End Sub
🙂 🙂 🙂 🙂 🙂