filtrer et transferer les données

  • Initiateur de la discussion Initiateur de la discussion hicham28
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

hicham28

XLDnaute Occasionnel
Bonsoir, et encore merci d’avance de m’aider,
J’aimerai transférer les données (la date / numéro / bénéficiaire et le montant) figurant sur les deux feuilles : effets émis et celle du leasing sur la base de deux critères : le mois et l’année et insérer ces données au dernier linge vide sur la feuille banque.
ca veux dire un filtre dois etre fais, selon le mois et l’année, avant le transfert , j’aimerai vraiment avoir votre aide, et merci
 
Re : filtrer et transferer les données

bonjour bebere et je vous remercie infiniment de votre aide,
j'ai modifier certaine chose sur le fichier, alors j'ai utiliser les checkbox au lieu des optionbutton. ca a marche comme j'ai souhaiter mais j'aimerai avoir votre confirmation si il y'as pas d'erreur sur le code, aussi j'aimerai y ajouter une chose :
j'aimerai eviter le transfert des doublons, ca veux dire j'aimerai controler avant effectuer le transfert, le controle purra se faire sur la base des numero des effets et leurs montant aussi le numero de leasing, j'espere etre claire, je vous joint le code, et j'espere vraiment avoir a nouveau votre aide, d'ailleurs sans vous j'aurai jamais ce resultat, et merci a nouveau
Code:
Dim Tbl As Variant, NomFeuil As String
Private Sub CheckBox1_Click()
If CheckBox1 Then
        NomFeuil = "EFFET_EMIS"
        IniCbo "F"
    End If
End Sub
Private Sub CheckBox2_Click()
 If CheckBox2 Then
        NomFeuil = "leasing"
        IniCbo "G"
    End If
End Sub

Private Sub ComboBox1_Change()
If ComboBox1 <> "" And ComboBox2 <> "" And CheckBox1 <> "" And CheckBox2 <> "" Then
CommandButton1.Enabled = True
End If
End Sub

Private Sub CommandButton1_Click()
    Dim L As Long, Li As Long, ModeP As String
    If Me.ComboBox1 <> "" And Me.ComboBox2 <> "" Then
        If NomFeuil = "leasing" Then
            ModeP = "Prélevement"
        Else
            ModeP = "Effet"
        End If
        With Worksheets("banque")
            Li = .Range("A5000").End(xlUp).Row
            For L = 1 To UBound(Tbl)
                If Year(Tbl(L, 2)) = Val(Me.ComboBox2.Value) Then
                    If Month(Tbl(L, 2)) = Val(Me.ComboBox1.Value) Then
                        Li = Li + 1
                        .Cells(Li, 1) = CDate(Tbl(L, 2))    'date
                        .Cells(Li, 2) = ModeP
                        .Cells(Li, 3) = Tbl(L, 1)    'ref
                        .Cells(Li, 4) = Tbl(L, 4)    'libellé
                        .Cells(Li, 7) = CDbl(Tbl(L, UBound(Tbl, 2)))    'débit
                    End If
                End If
            Next L
        End With
    End If
   CommandButton1.Enabled = False
End Sub
Private Sub CommandButton2_Click()
    Unload Me
End Sub

Private Sub ComboBox2_Change()
    Dim MonDico As Object, L As Long
    If ComboBox2.Value <> "" Then
        Me.ComboBox1.Clear
        'sans doublons
        Set MonDico = CreateObject("Scripting.Dictionary")
        For L = 1 To UBound(Tbl)
            If Year(Tbl(L, 2)) = Val(Me.ComboBox2.Value) Then
                If Not MonDico.Exists(Month(Tbl(L, 2))) Then MonDico.Add Month(Tbl(L, 2)), Month(Tbl(L, 2))
            End If
        Next
        Me.ComboBox1.List = MonDico.items
    End If
End Sub

Sub IniCbo(LetCol As String)
    Dim MonDico As Object, DerL As Long, L As Long
    Me.ComboBox2.Clear
    With Worksheets(NomFeuil)
        DerL = .Range("A5000").End(xlUp).Row
        .Range(.Cells(3, 1), .Cells(DerL, LetCol)).Sort Key1:=.Range("B4"), Order1:=xlAscending, Header:=xlGuess, _
                                                        OrderCustom:=5, MatchCase:=True, Orientation:=xlTopToBottom
                                                                                                                      
       Tbl = .Range(.Cells(4, 1), .Cells(DerL, LetCol))
        Set MonDico = CreateObject("Scripting.Dictionary")
        For L = 1 To UBound(Tbl)
            If Not MonDico.Exists(Year(Tbl(L, 2))) Then MonDico.Add Year(Tbl(L, 2)), Year(Tbl(L, 2))
        Next
    End With
    Me.ComboBox2.List = MonDico.items
End Sub

Private Sub UserForm_Initialize()
CommandButton1.Enabled = False
End Sub
 
Re : filtrer et transferer les données

bonjour Hicham
vois si cela convient(pas testé tous les cas)
ajouté format dans base
pour évité d'avoir les 2 cochées
dans le code checkbox ajoute
If CheckBox1 Then
CheckBox2=false

If CheckBox2 Then
CheckBox1=false

à bientôt
 

Pièces jointes

Re : filtrer et transferer les données

merci bebere,
pour ca marche comme il le faut, et d'ailleurs souvent j'ai besoin d'importer les données des deux feuilles, alors pour cette coté, ca me convient.

ce qui me reste et j'espere avoir encore de votre aide, c'est d'ajouter un controle des données avant d'effectuer le transfert, si par exemple je fais le transfert des données du mois de 9/2008, j'aimerai que le transfert s'effectue ke apres la verification si les données n'etais pas deja exporté vers la feuille banque.
j'espere etre claire et j'espere vraiment avoir votre aide a nouveau.
merci
 
Re : filtrer et transferer les données

sur un forum j'ai eu ce code pour la verification des doublons, mais je ne sais pas coment l'integrer correctement, voila le cde
Code:
Cette macro devrait correspondre à a requête :

Public Sub doubl()
Dim celo As Range 'déclare la variable celo (cellule origine)
Dim celc As Range 'déclare la variable celc (cellule comparée)
Dim plag As Range 'déclare la variable plag (plage de la colonne D)
Set plag = Range("D1" & Range("D65536").End(xlUp).Row) 'définit la variable plag
For Each celo In plag 'boucle pour chaque cellule origine de la plage
For Each celc In plag 'boucle pour chaque cellule comparée de la plage
If celo.Address = celc.Address Then GoTo suite 'si deux cellule ont la même adresse, prochaine comparée
If celo.Value = celc.Value Then GoTo fin 'si deux cellules identiques, balise fin
suite: 'balise
Next celc
Next celo
Exit Sub
fin: 'balise
celc.Select 'sélectionne la cellue comparée
celo.Interior.ColorIndex = 3 'motif cellule origine rouge
celc.Interior.ColorIndex = 3 'motif cellule comparée rouge
'message avec adresses de la cellule d'origine et de la celulle comparée
MsgBox ("les cellules " & celo.Address & " et " & celc.Address & " sont identiques")
celo.Interior.ColorIndex = 0 'aucun motif cellule origine
celc.Interior.ColorIndex = 0 'aucun motif cellule comparée
End Sub
merci
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
16
Affichages
1 K
B
Réponses
0
Affichages
892
BALLET
B
P
Réponses
0
Affichages
1 K
Ptinotsgnik
P
T
Réponses
2
Affichages
2 K
T
S
Réponses
2
Affichages
975
stephane-wizzard
S
Retour