Relance impayés VBA

Version imprimable

11/10/2023, 15h19
maximob

1 pièce(s) jointe(s)

Relance impayés VBA

Bonjour tout le monde

J'ai un tableau de relance des clients (LISTE) et je cherche à avoir ceux qui n'ont pas payé selon le critère mois (Q2Q) et le résultat dans la feuille (RELANCE).

Merci

VOICI MON FICHIER

Pièce jointe 645128

1 pièce(s) jointe(s)

Bonjour ami, la forum
A mon modeste avis il vaux mieux revoir la conception :
Rang /Matricule /Nom & prénom /Classe/Mois / N° GSM
puis tu insère un TCD avec des segments et tu aura ce que tu veux avec une belle présentation
et si tu ajoute une colonne pour l'année ... tu peux faire les comparaisons entre les année
si vous insister sur votre approche pour une raison que j'ignore tu peux tester
Code:

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 Sub CacherCol() Dim F1 As Worksheet Dim F2 As Worksheet Set F1 = Sheets("LISTE") Set F2 = Sheets("RELANCE") F2.Cells.ClearContents Application.ScreenUpdating = False F1.Cells.EntireColumn.Hidden = False For j = 5 To 14 If Not F1.Cells(1, j) = F1.Cells(2, "Q") Then Columns(j).Hidden = True Next j For X = 1 To 4 F1.Columns(X).Copy F2.Cells(1, X).PasteSpecial Paste:=xlPasteValues Next X MaVariable = F1.Cells(2, "Q") Set C = F1.Rows(1).Find(MaVariable, LookIn:=xlValues, LookAt:=xlWhole) Col = C.Column F1.Columns(Col).Copy F2.Cells(1, 5).PasteSpecial Paste:=xlPasteValues F1.Columns("O").Copy F2.Cells(1, 6).PasteSpecial Paste:=xlPasteValues F2.Select Application.CutCopyMode = False Application.ScreenUpdating = True End Sub

11/10/2023, 17h29
mach1974

li faut faire une formule de recherchev

il faut ajouter dans la feuille de relance la formule = si(estvide(E2) = FAUX;C3;"")
11/10/2023, 18h19
maximob

RE

La solution donnée par BENNASR que je remercie d'ailleurs n'est complète car le résultat doit trier les non payeurs selon mois choisi.
merci de revoir le code.

1 pièce(s) jointe(s)

Je n arrive pas a comprendre
Trier selon quelle colonne ??? Peux tu donner un exemple ?
Si je peux deviner vous avez des lignes vides sur la feuille destination que vous voulez supprimer ??? si oui :

Code:

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
Sub CacherCol()
Dim F1 As Worksheet
Dim F2 As Worksheet
Set F1 = Sheets("LISTE")
Set F2 = Sheets("RELANCE")
F2.Cells.ClearContents
Application.ScreenUpdating = False
    F1.Cells.EntireColumn.Hidden = False
    For j = 5 To 14
    If Not F1.Cells(1, j) = F1.Cells(2, "Q") Then Columns(j).Hidden = True
    Next j
    For X = 1 To 4
    F1.Columns(X).Copy
    F2.Cells(1, X).PasteSpecial Paste:=xlPasteValues
    Next X
    MaVariable = F1.Cells(2, "Q")
    Set C = F1.Rows(1).Find(MaVariable, LookIn:=xlValues, LookAt:=xlWhole)
    Col = C.Column
    F1.Columns(Col).Copy
    F2.Cells(1, 5).PasteSpecial Paste:=xlPasteValues
    F1.Columns("O").Copy
    F2.Cells(1, 6).PasteSpecial Paste:=xlPasteValues
    i = F2.Cells(Rows.Count, 1).End(xlUp).Row
    F2.Range("A1:f" & i).AutoFilter Field:=5, Criteria1:=""
    F2.Range("A2:f" & i).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    F2.ShowAllData
    F2.Select
    F1.Cells.EntireColumn.Hidden = False
    Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub