Bonsoir, Nicole,
Alors un petit exemple? Voici:
Alors le décor: j'ai un grand tableau,avec en colonne E des numéros
J'ai un formulaire qui me demande un premier et un dernier numéro (tbxDébut et TbxFin)
Je cherche à copier les lignes (enfin, certaines cellules dans les lignes) dont le numéro en colonne E est compris entre le premier et le dernier numéro saisi dans un nouveau classeur. Mais le problème est que les numéros saisis (premier et dernier) ne sont pas forcément présents dans la colonne E.
Donc voici ma macro (je mets en entier, tout le début consiste à vérifier que les données saisies ne sont pas idiotes, du style n°fin<n°début!)
Private Sub CmbExporter_Click()
Dim Début As Long, Fin As Long
If Val(Me.TbxDébut) < 1 Then
MsgBox "Le premier numéro de fil doit être forcément supérieur à zéro", vbInformation + vbOKOnly, "Erreur de saisie"
Me.TbxDébut = "1"
Exit Sub
End If
If Val(Me.TbxFin) < Val(Me.TbxDébut) Then
MsgBox "Le dernier numéro de fil doit être forcément supérieur au premier", vbInformation + vbOKOnly, "Erreur de saisie"
Me.TbxFin = Me.TbxDébut
Exit Sub
End If
If Application.WorksheetFunction.CountIf(Range("E4").Resize(Range("A65536").End(xlUp).Row - 3, 1), ">=" & Val(Me.TbxDébut)) - _
Application.WorksheetFunction.CountIf(Range("E4").Resize(Range("A65536").End(xlUp).Row - 3, 1), ">" & Val(Me.TbxFin)) = 0 Then
MsgBox "Il n'y a pas d'archive dans la plage recherchée!", vbInformation + vbOKOnly, "Aucune donnée."
Exit Sub
End If
Application.ScreenUpdating = False
Range("A5").Resize(Range("A65536").End(xlUp).Row - 4, 25).Sort Key1:=Range("E5"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom ' ICI, on trie d'abord par ordre croissant pour pouvoir utiliser la vonction VlookUp, équivalente de RechercheV
Début = Application.WorksheetFunction.VLookup(Val(Me.TbxDébut), Range("E5").Resize(Range("A65536").End(xlUp).Row - 4, 1), 1)
Vlookup(la valeur à chercher, la plage de recherche, 1=n° de colonne de recherche, ici il n'y a qu'une seule colonne)
Début = Range("E5").Resize(Range("A65536").End(xlUp).Row - 4, 1).Find(Début).Row
Une fois le numéro le plus proche trouvé, je le recherche à nouveau afin de trouver la ligne
If Val(Range("E1").Cells(Début, 1)) <> Val(Me.TbxDébut) Then Début = Début + 1
Fin = Application.WorksheetFunction.VLookup(Val(Me.TbxFin), Range("E5").Resize(Range("A65536").End(xlUp).Row - 4, 1), 1)
Fin = Range("E5").Resize(Range("A65536").End(xlUp).Row - 4, 1).Find(Fin).Row
Range("B1").Cells(Début, 1).Resize(Fin - Début + 1, 24).Copy
Application.Workbooks.Add
Range("A1").PasteSpecial xlPasteValues
Worksheets("Archives ForumXLD").Activate
Range("A5").Resize(Range("A65536").End(xlUp).Row - 4, 25).Sort Key1:=Range("E5"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom ' ICI, on retrie par ordre décroissantcar c'était ma configuration originale
Unload Me
Application.ScreenUpdating = True
End Sub
Bon, c'est peut-être un peu compliqué, mais c'est l'exemple que j'avais sous la main!
Bon courage et bonne soirée.