Discussion :

[vbadeb]

Bonsoir à tous,

Je ne suis encore qu'aux prémices de mon aventure VBA, et je n'arrive pas à comprendre mon problème (que je sais relativement facile malheureusement...)

Je m'explique : Je ne suis encore qu'au test avant de l'imputer à mon userform, mais le principe est de donner 3 critères qui viendront filtrer une base puis copier/coller les données dans une autre feuille.

Je souhaite donc qu'à chaque nouvelle manip', la macro vienne coller les données à la première ligne vide de la feuille réceptrice. (Rien d'extraordinaire...)

Cependant le code suivant fonctionne mais n'arrive pas à trouver la dernière ligne non vide sur la feuille réceptrice...

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
Sub Test()
Dim NbLg As Long
Dim LgDer As Long
Dim LgDer2 As Long
Dim TextBox1 As String
Dim TextBox2 As Integer
Dim TextBox3 As Date

Sheets("BASE COBRA histo").Select

  With Sheets("BASE COBRA histo")
    LgDer = .Range("A65536").End(xlUp).Row
    .Range("A1:I" & LgDer).AutoFilter Field:=1, Criteria1:="AF"

    NbLg = WorksheetFunction.Subtotal(3, Columns(1)) - 1
    If NbLg > 0 Then
    LgDer2 = Sheets("Feuil1").Range("C65536").End(xlUp).Row
      .Range("A2:G" & LgDer).SpecialCells(xlCellTypeVisible).Copy Sheets("Feuil1").Range("C1:I" & LgDer2)
    End If
    .ShowAllData
  End With
  
 Sheets("Feuil1").Select
End Sub

Si quelqu'un peut m'aider...
Merci à tous.
M.

[Invité]

Bonjour,

Une solution possible avec le code ci-dessous.

J'ai modifié votre procédure pour la rendre paramétrique (ce n'était pas obligatoire). La procédure CopierLesLignes est activée par TestCopierLesLignes, il suffit de lui donner les paramètres souhaités.

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
 
Sub TestCopierLesLignes()
 
    CopierLesLignes Sheets("BASE COBRA histo"), 1, 1, "AF", Sheets("Feuil1")
    Sheets("Feuil1").Activate
 
End Sub
 
Sub CopierLesLignes(ByVal FeuilleSource As Worksheet, ByVal TitreSource As Long, ByVal ColonneCritere As Long, ByVal CritereFiltre As String, ByVal FeuilleCible As Worksheet)
 
Dim DerniereLigneSource As Long
Dim DerniereLigneFiltreeSource As Long
Dim DerniereColonneSource As Long
 
Dim DerniereLigneCible As Long
 
    With FeuilleSource
         DerniereLigneSource = .Cells(.Rows.Count, 1).End(xlUp).Row
         DerniereColonneSource = .Cells(TitreSource, .Columns.Count).End(xlToLeft).Column
         .Range(.Cells(TitreSource, 1), .Cells(DerniereLigneSource, DerniereColonneSource)).AutoFilter Field:=ColonneCritere, Criteria1:=CritereFiltre
         DerniereLigneFiltreeSource = .Cells(.Rows.Count, ColonneCritere).End(xlUp).Row
 
         If DerniereLigneFiltreeSource > TitreSource Then
            DerniereLigneCible = FeuilleCible.Cells(.Rows.Count, 3).End(xlUp).Row
            .Range(.Cells(TitreSource + 1, 1), .Cells(DerniereLigneSource, 7)).SpecialCells(xlCellTypeVisible).Copy FeuilleCible.Range("C" & DerniereLigneCible + 1)
         'Else
         '   MsgBox "Aucune valeur !", vbCritical
         End If
         .ShowAllData
 
    End With
 
End Sub

Cordialement.

[vbadeb]

Eric, Merci de votre réponse rapide. Malgré tout j'ai réussi à trouver un code qui fonctionne lui aussi :

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
Private Sub CommandButton1_Click()
Dim NbLg As Long
Dim LgDer As Long
Dim LgDer2 As Long
Dim TextBox1 As String
Dim TextBox2 As Integer
Dim TextBox3 As Date

Sheets("BASE COBRA histo").Select

  With Sheets("BASE COBRA histo")
    LgDer = .Range("A65536").End(xlUp).Row
    .Range("A1:I" & LgDer).AutoFilter Field:=1, Criteria1:=TextBox1
    .Range("A1:I" & LgDer).AutoFilter Field:=3, Criteria1:=TextBox2
    .Range("A1:I" & LgDer).AutoFilter Field:=2, Operator:= _
        xlFilterValues, Criteria2:=Array(2, TextBox3)

    NbLg = WorksheetFunction.Subtotal(3, Columns(1)) - 1
    If NbLg > 0 Then
    LgDer2 = Sheets("Feuil1").Range("C65000").End(xlUp).Row + 1
      .Range("A2:G" & LgDer).SpecialCells(xlCellTypeVisible).Copy Sheets("Feuil1").Range("C" & LgDer2)
    End If
    .ShowAllData
  End With
  
 Sheets("Feuil1").Select
End Sub

Private Sub TextBox1_Change()

End Sub

Private Sub TextBox2_Change()

End Sub

Private Sub TextBox3_Change()

End Sub

Cependant, maintenant que j'ai remplacé mes variables "écrites", par les variables de mon userform, cela ne fonctionne plus.... Peut être m'y prendrai-je mal pour imputer les trois critères de recherche (un texte, un nombre, et une date)

Avez vous une idée du problème ?
Merci d'avance
CDLT
M.

[Invité]

Une solution à partir de ma précédente solution :

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
 
Sub CopierLesLignesV2(ByVal FeuilleSource As Worksheet, ByVal TitreSource As Long, ByVal CritereFiltre1 As String, ByVal CritereFiltre2 As Integer, ByVal CritereFiltre3 As Date, ByVal FeuilleCible As Worksheet)
 
Dim DerniereLigneSource As Long
Dim DerniereLigneFiltreeSource As Long
Dim DerniereColonneSource As Long
 
Dim ColCritere1 As Long
Dim ColCritere2 As Long
Dim ColCritere3 As Long
 
Dim Airesource As Range
 
Dim DerniereLigneCible As Long
 
    With FeuilleSource
         DerniereLigneSource = .Cells(.Rows.Count, 1).End(xlUp).Row
         DerniereColonneSource = .Cells(TitreSource, .Columns.Count).End(xlToLeft).Column
 
         ColCritere1 = 1
         ColCritere2 = 2
         ColCritere3 = 3
 
         Set Airesource = .Range(.Cells(TitreSource, 1), .Cells(DerniereLigneSource, DerniereColonneSource))
         With Airesource
              .AutoFilter Field:=ColCritere1, Criteria1:=CritereFiltre1
              .AutoFilter Field:=ColCritere2, Criteria1:=CritereFiltre2
              .AutoFilter Field:=ColCritere3, Operator:=xlFilterValues, Criteria1:=Array(2, CritereFiltre3)
        End With
        DerniereLigneFiltreeSource = .Cells(.Rows.Count, ColCritere1).End(xlUp).Row
 
        If DerniereLigneFiltreeSource > TitreSource Then
           DerniereLigneCible = FeuilleCible.Cells(.Rows.Count, 3).End(xlUp).Row
           .Range(.Cells(TitreSource + 1, 1), .Cells(DerniereLigneSource, 7)).SpecialCells(xlCellTypeVisible).Copy FeuilleCible.Range("C" & DerniereLigneCible + 1)
         'Else
         '   MsgBox "Aucune valeur !", vbCritical
        End If
       .ShowAllData
 
        Set Airesource = Nothing
 
    End With
 
End Sub

La ligne de commande dans le Userform :

Code :

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

1
2
3
4
5
6
7
 
Private Sub CommandButton1_Click()
 
    CopierLesLignesV2 Sheets("BASE COBRA histo"), 1, TextBox1, Val(TextBox2), CDate(TextBox3), Sheets("Feuil1")
    Sheets("Feuil1").Activate
 
End Sub

Nb : Il ne faut pas nommer vos variables avec le même nom que des objets (Textbox1, 2, 3).

Cordialement.