Re: Trie & Sélection
Bonjour Temjeh,
Pourquoi changes-tu toujours de fil de discussion ?
Je ne pense pas qu'il s'agisse de la meilleure façon d'obtenir une réponse ! Si tu étais un peu plus clair dans tes demandes... ce serait déjà plus simple.
Cela dit, après avoir parcouru les 3 fils suivant :
<http://www.excel-downloads.com/html/French/forum/read.php?f=1&i=97688&t=97683>
<http://www.excel-downloads.com/html/French/forum/read.php?f=1&i=97788&t=97788>
<http://www.excel-downloads.com/html/French/forum/read.php?f=1&i=97933&t=97933>
Je te propose l'exemple ci-joint avec le code ci-dessous :
Sub Recherche()
Dim TabTemp As Variant
Dim Cl As Workbook
Dim L As Long
Dim i As Long
Dim C As Byte
Dim DestClas As String
Dim Chem As String
Dim Ouvert As Boolean
DestClas = InputBox("Nom à rechercher en colonne E", "Recherche", "Toto")
If DestClas = "" Then Exit Sub
'Mémoriser les lignes et "Toper" celles correspondant au nom recherché
With ThisWorkbook.Sheets("Tous")
L = .Range("E65536").End(xlUp).Row
TabTemp = .Range(.Cells(1, 1), .Cells(L, 9)).Value
For i = 1 To L
If UCase(.Cells(i, 5).Value) = UCase(DestClas) Then
TabTemp(i, 9) = "x"
End If
Next i
End With
'Activation ou ouverture du classeur "Nom Recherché"
DestClas = DestClas & ".xls"
'Est-il déjà ouvert ?
For Each Cl In Workbooks
If Cl.Name = DestClas Then
Ouvert = True
Workbooks(DestClas).Activate
Exit For
End If
Next Cl
'Ouvrir le fichier
If Not Ouvert Then
On Error GoTo OuvreErreur
Chem = "C:\Program Files\Territoire 2004\"
Workbooks.Open Chem & DestClas
On Error GoTo 0
End If
'"Coller" les informations utiles et supprimer les lignes dans le fichier source
With Workbooks(DestClas).Sheets("Tous")
For i = 1 To UBound(TabTemp, 1)
If TabTemp(i, 9) = "x" Then
L = .Range("E65536").End(xlUp).Row + 1
For C = 1 To 8
.Cells(L, C).Value = TabTemp(i, C)
Next C
End If
Next i
End With
'Ferme le fichier en le sauvegardant
Workbooks(DestClas).Close True
'Supprime les lignes concernées dans le fichier source
With ThisWorkbook.Sheets("Tous")
For i = UBound(TabTemp, 1) To 1 Step -1
If TabTemp(i, 9) = "x" Then
ThisWorkbook.Sheets("Tous").Rows(i).Delete
End If
Next i
End With
Exit Sub
OuvreErreur:
MsgBox "Fichier " & Chem & DestClas & " inexistant !"
Exit Sub
End Sub
Il conviendra de modifier la ligne
Chem = "C:\Program Files\Territoire 2004\"
pour indiquer le chemin des fichiers de destination.
Ces derniers doivent être créés au préalable (avec une feuille nommée "Tous")
J'espère avoir compris ta demande et avoir ainsi répondu à cette dernière.
Cordialement,
Didier_mDF