Discussion :

[maximob]

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

[BENNASR]

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 :

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
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

[mach1974]

il faut ajouter dans la feuille de relance la formule = si(estvide(E2) = FAUX;C3;"")

[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.

[BENNASR]

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 :

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
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