Trie+CheckBox

[Temjeh]

Bonjour à tous en ce beau vendredi

J'ai cette macro :

Private Sub CheckBox2_Click()
If CheckBox2 = True Then
Range("A2:E2").Select
Application.CutCopyMode = False
Selection.Copy
If Range("A18") = "" Then
Range("A18").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
GoTo Fin
End If
If Range("A19") = "" Then
Range("A19").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
GoTo Fin
End If
If Range("A20") = "" Then
Range("A20").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
GoTo Fin
End If
If Range("A21") = "" Then
Range("A21").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
End If
Fin:
Application.CutCopyMode = False
Range("A2:E16").Select
Selection.Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("G2").Select
End Sub


Même chose pour plusieurs CheckBox sur plusieurs lignes(300)


Private Sub CheckBox3_Click()
If CheckBox3 = True Then
Range("A3:E3").Select
Application.CutCopyMode = False
Selection.Copy
If Range("A18") = "" Then
Range("A18").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
GoTo Fin
End If
If Range("A19") = "" Then
Range("A19").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
GoTo Fin
End If
If Range("A20") = "" Then
Range("A20").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
GoTo Fin
End If
If Range("A21") = "" Then
Range("A21").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
End If
Fin:
Application.CutCopyMode = False
Range("A2:E16").Select
Selection.Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("G2").Select
End Sub


Voici le prob: Quand je trie les CheckBox suivent mais là les formules ne marchent plus et si je coche ne pas déplacer ou redimentionner avec les cellules les CheckBox sont ok mais plus avec leurs lignes respective.

J'ai pensé a cette solution pour mon début de code:

Private Sub CheckBox2_Click()
If CheckBox2 = True Then
Range("A+Numéro de ligne:E+Numéro de ligne").Select

Coment l'écrire?

Merci beaucoup et A+

Temjeh

 

[Temjeh]

Rebonjour juste un autre info:

Si mon début fonctionne avec votre réponse

Private Sub CheckBox2_Click()
If CheckBox2 = True Then
Range("A+Numéro de ligne:E+Numéro de ligne").Select
Application.CutCopyMode = False
Selection.Copy
If Range("A18") = "" Then
Range("A18").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
GoTo Fin
End If
If Range("A19") = "" Then
Range("A19").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
GoTo Fin
End If
If Range("A20") = "" Then
Range("A20").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
GoTo Fin
End If
If Range("A21") = "" Then
Range("A21").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
End If
Fin:
Application.CutCopyMode = False
Range("A2:E16").Select
Selection.Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("G2").Select
End Sub

Est possible pour plus simple
For each CheckBox si true..... il exécute cette macro au lieu de la recopier 300 fois

Merci beaucoup