XL 2016 Report de lignes sous condition

[Petitom42]

Bonjour à tous!

Merci de m'accueillir dans ce forum

Je cherche désespérément une solution pour reporter des lignes d'une feuille à l'autre en fonction d'une condition prédéfinie, mais je suis assez novice dans la matière.

Je joins un fichier contenant des tableaux : https://1drv.ms/x/s!AogS0o3MZfZJga4AQGJCAcLyEOw2Ew?e=i5UPvn

Dans l'onglet qui s'appelle télécardio, il faudrait que se reportent automatiquement toutes les lignes des autres onglets pour lesquelles il y a un O dans la colonne TC.
Ainsi à chaque fois que l'on rajoute un O dans cette colonne, la ligne correspondante serait automatiquement ajoutée dans l'onglet télécardio.
Il serait alors possible manuellement de rajouter des informations dans les colonnes supplémentaires.

Pensez-vous qu'il existe une solution pour mettre cela en place?

Merci d'avance
Thomas

 

[Petitom42]

Bonjour Petitom42, le fil, le forum,

En effet il faut traiter le tableau existant avant de restituer les résultats.

Dans ce fichier (2) on utilise un Dictionary pour repérer les lignes à supprimer :

Private Sub Worksheet_Activate()
Dim ncol%, resu(), d As Object, w As Worksheet, tablo, i&, n&, x$, j%, repere(), ub%
ncol = 13 'nombre de colonnes à copier
ReDim resu(1 To Rows.Count, 1 To ncol)
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
For Each w In Worksheets
    If w.Name <> Me.Name Then
        tablo = w.UsedRange.Resize(, ncol)
        For i = 2 To UBound(tablo)
            If UCase(tablo(i, 10)) = "O" Then
                n = n + 1
                If IsNumeric(CStr(tablo(i, 1))) Then tablo(i, 1) = CDbl(tablo(i, 1)) 'en cas de valeur texte
                x = ""
                For j = 1 To ncol
                    resu(n, j) = tablo(i, j)
                    If j < 10 Then x = x & Chr(1) & tablo(i, j)
                Next j
                d(x) = ""
            End If
        Next i
    End If
Next w
'---repérages dans le tableau existant---
tablo = UsedRange.Resize(, 9)
ReDim repere(1 To UBound(tablo), 1 To 1)
For i = 2 To UBound(tablo)
    x = ""
    For j = 1 To 9
        x = x & Chr(1) & tablo(i, j)
    Next j
    If d.exists(x) Then repere(i, 1) = 1 'repère
Next i
repere(1, 1) = 1
'---1ère restitution et suppressions---
Application.ScreenUpdating = False
If FilterMode Then ShowAllData 'si la feuille est filtrée
ub = ncol + 1
With UsedRange
    .Columns(ub).EntireColumn.Insert 'insère une colonne auxiliaire
    .Columns(ub) = repere
    .EntireRow.Sort .Columns(ub) 'tri pour regrouper et accélérer
    On Error Resume Next 'si aucune SpecialCell
    .Columns(ub).SpecialCells(xlCellTypeBlanks).EntireRow.Delete 'suppressions
    .Columns(ub).EntireColumn.Delete 'supprime la colonne auxiliaire
    On Error GoTo 0
End With
'---2ème restitution---
If n Then Cells(Cells(Rows.Count, 10).End(xlUp).Row + 1, 1).Resize(n, ncol) = resu
UsedRange.RemoveDuplicates Array(1, 2, 3, 4, 5, 6, 7, 8, 9), Header:=xlYes 'supprime les lignes en doublon
Columns.AutoFit 'ajuste les largeurs
With UsedRange: End With 'actualise la barre de défilement verticale
End Sub

Edit : j'ai modifié pour convertir les valeurs textes en colonnes A.

A+

Bonjour,

Avec celle-ci j'ai l'impression que ça marche nickel
Je vous dirai si j'ai des soucis.

Un grand merci à tous pour votre participation et votre accueil et au plaisir

Thomas

 

[Petitom42]

Bonjour à tous!

Je réouvre le topic car la solution ne me convient pas parfaitement.

Pour rappel, la manœuvre que je cherchais consistait initialement à copier toutes les lignes des feuilles 2019 à 2021 qui comprenaient la lettre O dans la feuille "télécardio" afin de noter des données complémentaires en face.
Le problème est qu'avec cette façon de faire, les données rentrées manuellement dans les colonnes supplémentaires du tableau télécardio sont perdues dans le cas où le O est enlevé. Il y avait également encore des problèmes de doublons.

J'ai donc rajouté toutes les colonnes supplémentaires dans les feuilles 2008 à 2021 et il faudrait :
1. Que l'ensemble des lignes rajoutées dans l'une de ces feuilles (en excluant les autres feuilles, telles que "stats") soient reportées dans l'onglet télécardio (j'appliquerai les critères de tri pour que seules les lignes avec un "O" apparaissent.
2. Que toute modification de donnée dans une feuille 2008 à 2021 OU dans la feuille télécardio soit retranscrite automatiquement dans l'autre.
3. Qu'il soit possible pour moi de modifier les noms des feuilles à retranscrire (par exemple le jour où on ajoutera une feuille 2022).

TC essai.xls

Microsoft Excel Workbook

1drv.ms

Par avance, un grand MERCI

Thomas

 

[job75]

Bonjour Petitom42, le forum,

Donc vous ne savez pas ce que vous voulez.

Puisque maintenant vous ne vous occupez plus des "O" créez une nouvelle discussion avec des explications claires en montrant ce que vous voulez obtenir.

Epurez votre fichier avec des nombres qui soient des nombres et des dates qui soient toutes des dates.

Et joignez des fichiers Excel normaux au lieu d'utiliser OneDrive.

A+