XL 2016 Report de lignes sous condition

Petitom42

XLDnaute Nouveau
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
 
Dernière édition:

Petitom42

XLDnaute Nouveau
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 :
VB:
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

XLDnaute Nouveau
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).


Par avance, un grand MERCI :)

Thomas
 

job75

XLDnaute Barbatruc
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+
 

Discussions similaires