Sélectionner les lignes comportant tous un X dans la même colonne ds une autre feuill

[IZA030]

Bonjour,

Je suis débutante dans excel mais j'apprends vite et je me débrouille normalement bien !!

J'ai un tableau pour une compétition de mud drag et il comporte plusieurs feuilles (pour chaque classe de compétition)
et j'aimerais que dans la première feuille (inscription) lorsque que je met un X dans la colonne appropriée, la ligne (soit les 3 colonnes: #, nom, ville) soit copiée dans la bonne feuille (nommée comme la colonne du X).

Je joint le fichier pour que vous puissiez mieux me comprendre!!

Merci beaucoup à l'avance !!

 

[don_pets]

Re : Sélectionner les lignes comportant tous un X dans la même colonne ds une autre f

'llo,

Voilà une solution qui n'est pas la plus belle, mais bon j'ai fait avec ton fichier ^^

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Sheets("INSCRIPTIONS").Activate

For i = 2 To Range("A6553").End(xlUp).Row

        If Cells(i, 4) = "X" Then
            derligne = Sheets("4 STOCK ").Range("A65535").End(xlUp).Row + 1
            Range(Cells(i, 1), Cells(i, 3)).Cut Destination:=Sheets("4 STOCK ").Range("A" & derligne)
            Rows(i).Delete
            
        End If
        
Next i

End Sub

 

[IZA030]

Re : Sélectionner les lignes comportant tous un X dans la même colonne ds une autre f

Merci!!

Je vais passer pour vraiment une débutante, mais je l'inscrit où cette formule? Je me rends compte que les p'tites formules que j'utilise fréquemment ne sont vraiment rien à comparer de celle-ci !!

 

[Paf]

Re : Sélectionner les lignes comportant tous un X dans la même colonne ds une autre f

Bonjour IZA030, don_pets

un autre code, encore imparfait et à affiner en fonction des besoins ultérieurs, à coller dans la feuille VBE (Alt+F4 pour y accéder) de la feuille INSCRIPTIONS .

attention, les noms des feuilles et les noms figurant en ligne 2 ne sont pas strictement les mêmes (espace en plus ou en moins) . A corriger d'un côté ou de l'autre.

Private Sub Worksheet_Change(ByVal Target As Range)
 Dim Plage As String, Derlig As Long
 If Not Intersect(Target, Range("E3:N" & Range("C" & Rows.Count).End(xlUp).Row)) Is Nothing Then
    Plage = "B" & Target.Row & ":D" & Target.Row
    If WorksheetFunction.CountBlank(Range(Plage)) > 0 Then
        MsgBox "vous n'avez pas tout saisi"
        Exit Sub
    Else
        Derlig = Worksheets(CStr(Cells(2, Target.Column))).Range("B" & Rows.Count).End(xlUp).Row + 1
        Range(Plage).Copy Worksheets(CStr(Cells(2, Target.Column))).Range("B" & Derlig)
    End If
 End If
End Sub

A+

 

[job75]

Re : Sélectionner les lignes comportant tous un X dans la même colonne ds une autre f

Bonsoir IZA030, don_pets, Paf,

J'ai en effet enlevé les espaces superflus des noms des onglets.

Cette macro dans le code de la feuille "INSCRIPTIONS" (clic droit sur l'onglet et Visualiser le code) :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim r, i&, x, y, z, t, f$, tablo, j&
Set r = Intersect(Target, Range("E3:N" & Rows.Count), Me.UsedRange)
If r Is Nothing Then Exit Sub
For Each r In r 'si entrées multiples
  If r <> "" Then
    i = r.Row
    x = Cells(i, 2): y = Cells(i, 3): z = Cells(i, 4)
    If x = "" Or y = "" Or z = "" Then r.Value = "": GoTo 1
    t = x & y & z
    f = Trim(Cells(2, r.Column))
    With Sheets(f)
      tablo = Intersect(.Range("B2:D" & .Rows.Count), .UsedRange)
      For j = 2 To UBound(tablo)
        If tablo(j, 1) & tablo(j, 2) & tablo(j, 3) = t Then _
          MsgBox "La ligne " & i & " est déjà en feuille '" & f & "' !", 48: GoTo 1
      Next
      .Cells(.Rows.Count, 2).End(xlUp)(2).Resize(, 3) = Cells(i, 2).Resize(, 3).Value
    End With
  End If
1 Next
End Sub

Fichier joint.

Maintenant, logiquement, il faudrait supprimer les lignes transférées si l'on efface le "x".

Nous verrons ça demain.

Bonne nuit.

 

[job75]

Re : Sélectionner les lignes comportant tous un X dans la même colonne ds une autre f

Bonjour le fil, le forum,

Dans ce fichier (2) :

1) j'ai un peu modifié le code précédent avec un message si une feuille n'est pas trouvée

2) j'ai ajouté ce code dans ThisWorkbook :

Option Compare Text 'la casse est ignorée

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim base, col%, ub&, tablo, i&, t$, j&
base = Feuil1.Range("A1:A2", Feuil1.UsedRange) 'CodeName de la feuille
For col = 5 To UBound(base, 2)
  If Trim(base(2, col)) = Sh.Name Then
    ub = UBound(base)
    tablo = Sh.Range("A1:A2", Sh.UsedRange)
    For i = 3 To UBound(tablo)
      t = tablo(i, 2) & tablo(i, 3) & tablo(i, 4)
      If t <> "" Then
        For j = 3 To ub
          If base(j, 2) & base(j, 3) & base(j, 4) = t And base(j, col) <> "" Then GoTo 1
        Next
      End If
      Sh.Cells(i, 2).Resize(, 100).ClearContents 'effacement
1   Next
    '---tri alphabétique sur les noms---
    Sh.Range("B3", Sh.Cells(Sh.Rows.Count, 100)).Sort Sh.[C3], Header:=xlNo
    Exit For
  End If
Next
End Sub

La macro se déclenche quand on active une feuille quelconque.

Les données d'une feuille sont effacées si l'on efface le "x" où si la ligne a été supprimée en feuille "INSCRIPTIONS".

A+