Private OS As Worksheet 'déclare la variable OS (Onglet Source)
Private OD As Worksheet 'déclare la variable OD (Onglet Destination)
Private TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Private Sub UserForm_Initialize() 'à l'initialisation de l'UserForm
Set OS = Worksheets("feuil1") 'définit l'onglet source OS
Set OD = Worksheets("Archives") 'définit l'onglet destination OD
TV = Range("A1").CurrentRegion 'définit le tableau des valeurs TV
With Me.ListBox1 'prend en compte la Listbox1
.ColumnCount = 10 'définit le nombre de colonnes de la Listbox1 (max 10)
End With 'fin de la prise en compte de la ListBox1
End Sub
Private Sub TextBox1_Change()
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Integer 'déclare la variable J (incrément)
Dim K As Integer 'déclare la variable K (incrément)
Dim L As Integer 'déclare la variable L (incrément)
Dim TL() As Variant 'déclare la variable TL(tableau des Lignes)
Me.ListBox1.Clear 'vide la ListBox1
If Me.TextBox1.Value = "" Then Exit Sub 'si la TextBox1 est effacée, sort de la procédure
K = 1 'initialise la variable K
For I = 2 To UBound(TV, 1) 'boucle 1 : sur toutes les lignes I du tableau des valeurs TV (en partant de la quatrième)
For J = 1 To 10 'boucle 2 : sur les 6 premières colonnes J du tableau des valeurs TV
If InStr(1, TV(I, J), Me.TextBox1.Value, vbTextCompare) <> 0 Then 'condition : si le texte de la TextBox1 est contenu dans la donnée ligne I colonne J de TV
ReDim Preserve TL(1 To 10, 1 To K) 'redimensionne le tableau des lignes TL (6 lignes, K colonnes)
For L = 1 To 10 'boucle 3 : sur les 6 premières colonnes L du tableau des valeurs TV
TL(L, K) = TV(I, L) 'récupère dans la ligne L de TL la donnée en colonne L de TV (=> tranposition)
Next L 'prochaine colonne de la boucle 3
K = K + 1 'incrémente K (ajoute une colonne au tableau des lignes TL)
Exit For 'sort de la boucle 2
End If 'fin de la condition
Next J 'prochaine colonne de la boucle 2
Next I 'prochaine ligne de la boucle 1
If K > 1 Then Me.ListBox1.Column = TL 'si K est supérieure à 1, alimente la listBox1 avec le tableau des lignes TL
End Sub
Private Sub ListBox1_Click()
Dim F As String 'déclare la variable F (cell1)[MOD]
Dim C As String 'déclare la variable C (cell2)[MOD]
Dim D As String 'déclare la variable D (cell3)[MOD]
Dim N As String 'déclare la variable N (cell4)[MOD]
Dim PL As Range 'déclare la variable PL (cell5)
Dim PLV As Long 'déclare la variable PLV (Première Ligne Vide)
Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
Set PL = OS.Range("A1") 'initialise la plage PL
For I = 2 To UBound(TV, 1) 'boucle 1 : sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
F = Me.ListBox1.Column(1, Me.ListBox1.ListIndex) 'déclare la COL de PL à afficher Box confirmation [MOD]
C = Me.ListBox1.Column(0, Me.ListBox1.ListIndex) 'déclare la COL de PL à afficher Box confirmation [MOD]
D = Me.ListBox1.Column(7, Me.ListBox1.ListIndex) 'déclare la COL de PL à afficher Box confirmation [MOD]
N = Me.ListBox1.Column(8, Me.ListBox1.ListIndex) 'déclare la COL de PL à afficher Box confirmation [MOD]
If TV(I, 2) = Me.ListBox1.Column(1, Me.ListBox1.ListIndex) Then
'redéfinit la plage PL (la ligne (I+2) si PL ne contient qu'une seule cellule, sinon l'union de la plage PL et de la ligne (I+2))
Set PL = IIf(PL.Cells.Count = 1, OS.Cells(I, 1).Resize(1, 35), Application.Union(PL, OS.Cells(I, 1).Resize(1, 35)))
End If 'fin de la condition
Next I 'prochaine ligne de la boucle
'si "Non" au message, sort de la procédure
If MsgBox("blabla, vbYesNo, "ATTENTION") = vbNo Then Exit Sub
PLV = OD.Cells(Application.Rows.Count, "A").End(xlUp).Row + 1 'de'finit la première ligne vide PLV de la colonne A de l'ongelt OD
PL.Copy OD.Cells(PLV, 2) 'copie la plage PL et la colle dans la cellule ligne PLV colonne 1 de l'onget OD
OD.Cells(PLV, 1).Resize(PL.Rows.Count, 1).Value = Now 'renvoie la date dans la colonne A
PL.Range("F1").ClearContents 'efface cellule plage PL [MOD]
OD.Activate 'active l'onglet OD (ligne à supprimer éventuellement)
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
Unload Me
''Box confirmation et retour page [MOD]
MsgBox "blabla?"
With ActiveWorkbook
.Sheets("feuil1").Activate
PL.Range("F1").Cells.Select
End With
''''fin box confirmation [MOD]
End Sub