Macro pour tri et suppression de lignes

Bonjour à tous

Quelqu'un aurait-il la gentillesse de m'écrire une macro qui

englobe dans un unique module les actions suivantes:

1- feuille Table CONSIGNES - sélectionner la colonne A - Trier et

filtrer - Trier de A à Z - Etendre la sélection - Tri

2 - feuille GOLF - supprimer toutes les lignes qui ont la valeur #REF!

dans la colonne A

Les feuilles sont dans le même classeur : "Contrôles 2011"

Je vous remercie par avance pour votre aide.

Bernard.

Bonsoir,

Avec un fichier, çà sera + facile de t'aider,

pas besoin de toutes les lignes, mais la structure réelle

Amicalement

Claude

Bonsoir

Voici la structure du fichier.

Bernard

Bonjour

Si cela peut aider, j'utilise cette macro bien pratique pour suprimer des lignes selon des critères. Par exemple si on veut supprimer les lignes dont une valeur précise se trouve dans une colonne, disons la 6, c'est l'outils parfait et rapide. A essayer absolument. Dans mon cas j'ai des bases de données sur des clients de plusieurs pays et je dois les séparer selon les codes de pays. Une fois la zone de donnée sélectionnée, avec les codes de pays qui sont dans la colonne 6, et le critère est =42, il me restera toutes les données de client des pays dont le code N"EST PAS 42. Pour les autres pays on peut chosir <>42 en elevant tous sauf les données des client du pays 42.

Bonne chance.

Sub SupprimerDesRangéesSelonDesCritères()

Dim rRange As Range

Dim strCriteria As String

Dim lCol As Long

Dim rHeaderCol As Range

Dim xlCalc As XlCalculation

Const strTitle As String = "OZGRID CONDITIONAL ROW DELETE"

On Error Resume Next

Step1:

'We use Application.InputBox type 8 so user can select range

Set rRange = Application.InputBox(Prompt:="Select range including header range - sélectionner la zone incluant les titres de colonnes" _

, Title:=strTitle & " STEP 1 of 3", Default:=ActiveCell.CurrentRegion.Address, Type:=8)

'Cancelled or non valid rage

If rRange Is Nothing Then Exit Sub

'Awlays use GoTo when selecting range so doesn't matter which Worksheet

Application.Goto rRange.Rows(1), True

Step2:

'We use Application.InputBox type 1 so return a number

lCol = Application.InputBox(Prompt:="Please enter relative column number of evaluation column - Choisir le numéro de la colonne" _

, Title:=strTitle & " STEP 2 of 3", Default:=1, Type:=1)

'Cancelled

If lCol = 0 Then Exit Sub

Step3:

'We use default InputBox type as we want Text

strCriteria = InputBox(Prompt:="Please enter a single criteria. Taper les critères de sélection" & _

vbNewLine & "Eg >5 OR <10 OR Cat* OR *Cat OR *Cat*" _

, Title:=strTitle & " STEP 3 of 3")

If strCriteria = vbNullString Then Exit Sub

'Store current Calculation then switch to manual.

'Turn off events and screen updating

With Application

xlCalc = .Calculation

.Calculation = xlCalculationManual

.EnableEvents = False

.ScreenUpdating = False

End With

'Remove any filters

ActiveSheet.AutoFilterMode = False

With rRange 'Filter, offset(to exclude headers) and delete visible rows

.AutoFilter Field:=lCol, Criteria1:=strCriteria

.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete

End With

'Remove any filters

ActiveSheet.AutoFilterMode = False

'Revert back

With Application

.Calculation = xlCalc

.EnableEvents = True

.ScreenUpdating = True

End With

On Error GoTo 0

End Sub

Bonjour

Merci pour ton aide.

Je vais essayer d'adapter cette macro pour mon fichier demain (enfin, vu l'heure, plus tard dans la journée!) mais je ne suis pas certain d'y parvenir.........

Bon week-end.

Bernard.

Bonjour à tous,

Dans feuille "Table...", double clic dans colonne "A" pour supprimer la ligne dans les 2 feuilles

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim Lg%
'--- Supprime ligne ---
    If Not Application.Intersect(Target, Range("a2:a" & [a65536].End(xlUp).Row)) Is Nothing Then
        If Target.Count > 1 Then Exit Sub
        With Sheets("GOLF")
            On Error Resume Next
            Lg = WorksheetFunction.Match(Target, .Range("a:a"), 0)
            On Error GoTo 0
            If Lg > 0 Then
                .Rows(Lg).Delete
            End If
        End With
            Target.Rows.EntireRow.Delete
            Application.Goto Range("a1"), Scroll:=True
    End If
End Sub

Le bouton "Tri", trie et incrémente la formule en "Aj",

j'ai supprimé la fonction (que je ne maitrisais pas)

Sub Tri()
Dim Lg%
    Application.ScreenUpdating = False
    Lg = Range("a65536").End(xlUp).Row
    '--- tri ---
    Range("a2:ba" & Lg).Sort Key1:=Range("a2"), Order1:=xlAscending, _
    Header:=xlNo, OrderCustom:=1, MatchCase:=False
    '--- formule AJ ---
    Range("aj2:aj" & Lg) = _
    "=CONCATENATE(d2,e2,g2,f2,h2,L2,k2,i2,j2,m2,z2,aa2,ab2,ac2,ad2,ae2,af2,ag2)&SEP"
End Sub

à tester

Amicalement

Claude

Bonjour Claude

Merci.

Je ne peux pas tester dans l'immédiat (Des problèmes....... )

Je le fais dès que possible (Peut-être pas avant lundi, hélas)

Dans tous les cas, je vous tiens informer du résultat.

Cordialement.

Bernard.