Boucle pour extraire une liste de clients spécifique

**cup_of_thea** · 05/04/2019, 11h19

Bonjour,

je souhaiterai automatiser la manipulation quotidienne sur un fichier. Ce fichier est complété chaque jour (un onglet par mois) pour remonter les déclarations de fraude à la carte des clients. Les clients ayant déclaré un montant total <=600€ sont ensuite à envoyer à la comptabilité dans un onglet à part (c'est ce qui nous intéresse ici).

j'ai déjà bien amorcé le programme mais je sèche un peu pour tenir compte uniquement des n° client ayant un total déclaré <=600€ dans le sens où nous sommes sur du ligne à ligne (et pas sur un cumul total). Vous trouverez en PJ le fichier.

Dans l'onglet "AVRIL 2019" en colonne A le numéro dossier et en colonne D le montant déclaré pour chaque transaction frauduleuse. Le format de cet onglet ne doit pas changer. Pour un client, il y a donc plusieurs lignes.
L'onglet "LISTE DOSSIERS" sera l'onglet à envoyer à la compta. On doit y retrouver le numéro du dossier, le numéro de l carte, la date de l'opération et le montant contesté.

MErci beaucoup par avance pour votre aide !!

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
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
'---------------------------------------------------------------------------------------------------------
'
'                                       PROGRAMME VBA AUTOMATISATION
'
'Auteur : 
'Date de création : 04/04/2019
'
'---------------------------------------------------------------------------------------------------------
 
' Objectif : automatiser l'envoi quotidien des clients ayant des montants contestés <= à 600€
 
 
Sub extract()
 
'<< 0 >> - Paramétrage
 
Dim i As Integer
Dim list As Worksheet
Dim ws As Worksheet
Dim mois As String
Dim an As String
Dim lastline As Long
 
mois = UCase(Format(Now, "mmmm")) 'Déclaration du mois
an = Year(Date) 'Déclaration de l'année
 
Set list = ThisWorkbook.Worksheets("LISTE DOSSIERS") 'Déclaration de l'onglet avec la liste des clients à envoyer à la compta
Set ws = ThisWorkbook.Worksheets(mois & " " & an)
 
lastline = ThisWorkbook.Worksheets(mois & " " & an).Range("I" & Rows.Count).End(xlUp).Row
 
 
'<< 1 >> - Compteur pour faire la somme des montants déclarés (colonne 40, pour être pas vu ou écraser l'existent)
i = 5
temp = 0
Do
    If ws.Cells(i, 6) <> "" And Cells(i + 1, 6) = "" Then
        temp = ws.Cells(i, 13)
    ElseIf (ws.Cells(i, 6) = "" And Cells(i + 1, 6) = "") Or (ws.Cells(i, 6) = "" And Cells(i + 1, 6) <> "") Then
        temp = temp + ws.Cells(i, 13)
    End If
 
    If temp <= 600 Then
        ws.Cells(i, 41) = "ok"
    Else:
        ws.Cells(i, 41) = "ko"
    End If
 
    If ws.Cells(i, 6) <> "" And ws.Cells(i + 1, 6) = "" Then
        ws.Cells(i, 42) = ws.Cells(i, 6)
    Else:
        ws.Cells(i, 42) = ws.Cells(i - 1, 42)
    End If
 
i = i + 1
Loop While (ws.Cells(i, 13) <> "")
 
 
'<< 2 >> - Boucle pour récupérer les clients ayant un total <= à 600€
 
Sheets.Add
ActiveSheet.Name = "temp"
Set temp = ThisWorkbook.Worksheets("temp")
lastline_bis = ThisWorkbook.Worksheets("temp").Range("A" & Rows.Count).End(xlUp).Row
 
ws.Range("AO:AP").Copy Destination:=temp.Range("A1")
 
i = 5
Do
    If temp.Cells(i, 1) Like "ko" Then
            Range(temp.Cells(i, 1), temp.Cells(i, 2)).Delete
    End If
Loop While (temp.Cells(i, 2) = temp.Cells(i + 1, 2))
i = i + 1
 
 
 
'<< 3 >> - Envoie du mail à la compta
 
'Dim Ol As Object
'Dim Olmail As Object
'Dim CurrFile As String
 
'Set Ol = CreateObject("outlook.application")
'Set Olmail = Ol.CreateItem(olMailItem)
 
 
'ThisWorkbook.Worksheets("LISTE DOSSIERS").Copy
'ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & "Liste_clients_fraude_CB"
 
'MsgBox "Le fichier est prêt à être envoyé."
 
' Paramétrage du mail :
    'With Olmail
        '.To = "" ' A... '-> on ne peut pas automatiser le destinataire car celui-ci change tout le temps
        '.CC = "" ' Cc... (Notes qu'il y a un seul destinataire pour la copie, et tu peux en rajouter autant que tu veux mais en y séparant du point virgule ";"
        '.Subject = " Extraction fraudes CB du " & Format(Date, "dd/mm/yy") ' Objet du mail -> dynamique selon le nom du client et la date du jour
        '.body = "Bonjour," & _
                'Chr(13) & Chr(13) & "Veuillez trouver ci-joint la liste des clients du jour" & _
                'Chr(13) & Chr(13) & "Bonne réception," & Chr(13) & Chr(13) & "L'équipe Fraude"
 
        '.Attachments.Add ActiveWorkbook.FullName 'joindre le fichier
        '.Send '"Display" pour afficher la fenêtre Outlook....  ou "Send" pour envoyer le mail directement.
    'End With
 
End Sub