Discussion :

[BarneyYagami]

Bonjour à tous,

Débutant en vba, j'aurais besoin d'un peu d'aide sur un projet.

J'ai un fichier( joint) dans lequel se trouve 4 onglets (extract, trash2, onglet1, onglet2).

Dans l'onglet trash2, se trouvent les noms, le sport et la date de blessure de sportifs, dans l'onglet extract se trouvent une liste indépendantes de sportifs dans laquelle les données qui vont nous intéresser sont le nom et le sport des sportifs.

La macro, (onglet trash2), affiche un calendrier dans lequel on saisit une date.si cette date est postérieure à la date de blessure d'un sportif alors elle copie la ligne du sportif et la copie dans l'onglet 1.

Je voudrais en fait que lorsque la date saisie est postérieure à la date de blessure du sportif ET que ce sportif (nom ET sport) est présent dans la liste de l'onglet Trash2, alors il soit copié dans l'onglet 1 sinon il est copié dans l'onglet 2.

Savez-vous comment je pourrais faire?

En vous remerciant par avance.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
 
Option Explicit
 
Sub CopieLigne()
Dim lrow As Integer
Dim lcop1 As Integer
Dim lcop2 As Integer
Dim lcop3 As Integer
Dim lcop4 As Integer
Dim clean As Integer
Dim I As Integer
Dim smes As String
Dim dref As Date
 
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
 
clean = Worksheets("Trash2").Cells(1, "A").End(xlUp).Row + 1
 
Sheets("onglet1").Select
        Range("A2:G2").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.Clear
Sheets("onglet2").Select
       Range("A2:G2").Select
       Range(Selection, Selection.End(xlDown)).Select
       Selection.Clear
 
 
lrow = Worksheets("Trash2").Cells(Cells.Rows.Count, "A").End(xlUp).Row
 
    smes = Calendard.Chargement
   'smes = Application.InputBox("Merci de saisir la Date de Référence")
 
  If IsDate(smes) Then
      dref = DateValue(smes)
  Else
      MsgBox "Date Non Valable"
      Exit Sub
  End If
 
For I = lrow To 2 Step -1
 
If IsDate(Worksheets("Trash2").Cells(I, 7).Value) And IsEmpty(Worksheets("Trash2").Cells(I, 7)) = False Then
 
    lcop1 = Worksheets("Onglet2").Cells(Cells.Rows.Count, "A").End(xlUp).Row + 1
    lcop2 = Worksheets("onglet1").Cells(Cells.Rows.Count, "A").End(xlUp).Row + 1
 
    If Worksheets("Trash2").Cells(I, 7).Value < dref And IsEmpty(Worksheets("Trash2").Cells(I, 8)) Then
        Worksheets("Trash2").Cells(I, 7).EntireRow.Copy Destination:=Worksheets("onglet1").Cells(lcop2, 1)
        'Worksheets("onglet1").Cells(lcop2, 8).FormulaR1C1 = Cells(lcop2, 1) & "-" & Cells(lcop2, 3)
 
    'ElseIf Worksheets("Trash2").Cells(I, 7).Value < dref And IsEmpty(Worksheets("Trash2").Cells(I, 8)) Then
       ' Worksheets("Trash2").Cells(I, 7).EntireRow.Copy Destination:=Worksheets("onglet1").Cells(lcop1, 1)
 
    End If
 
Else
      Exit Sub
End If
 
Next I
 
End Sub