Select "incrémental"

Bonjour à toutes & à tous,

Et par avance, un grand MERCI pour votre aide; car après plusieurs heures de test et d'essai, je réalise que je n'arriverai pas à trouver la solution tout seul a mon grand dam.

Je vous explique mon problème.

Voici un "exemple" de données pour ce que je souhaite faire:

Col = Colonne, L = Ligne

#

---- ColC - ColD - ColE

L3_ Proprio - Titre - Date

L4_ Tom - A - X

L5_ Tom - B - X

L6_ Tom - C - X

L7_ Alan - D - X

L8_ Paul - E - X

L9_ Paul - F - X

etc...

#

J'ai donc un nombre imprévisible de ligne dans un tableau, qui commence en (C,3) ("Proprio" ci-dessus). Lignes contenant un nom, un titre, et une date. Ici un exemple avec 3 propriétaires différents (Tom, Alan, Paul)

L'objectif du code se traduirai de la sorte:

Dans la colonne C, à partir de la ligne 4: si la cellule du dessous est égal à la celulle du dessus (C4 = C5 ?); je sélectionne les deux ligne, de C à E... puis je vais à la prochaine ligne; et même chose, si la cellule du dessous (3ême ligne cette fois) est égal à celle du dessus (C5 = C6 ?) (ou à la première - C4 = C6?!), je la sélectionne aussi... De cette façon, avec ce principe, je dois arriver à une sélection de 3 lignes (puisque j'ai 3 "Tom").

Déjà, je n'arrive pas à faire ça .... cette "sélection incrémental"; je m'arrête à 2 maximum; et jamais aux bon endroits (soit les 2 premières ligne; soit les 2 dernières...).

Puis enfin, prochaine cellule (comme précédemment), si C7 = C4 (ou C5 ou C6...); alors je.... ah bah non, "Tom" <> "Alan"; je sélectionne plus rien (j'ai donc en pratique 3 ligne de "Tom3); et j'envoi un email.

Je sais envoyer l'email (m'a bien pris du temps aussi ça....), mais j'ai toujours le problème de trouver la limite de la sélection.

Une fois l'email envoyé ?

Repartir depuis C7 qui était différent des cellules précédents...

Et comme je n'ai qu'une seule ligne d'"Alan", et bien j'envoi mon mail avec juste "Alan".

Puis même chose avec "Paul", qui doit me faire un select des 2 lignes de Pauls.... et les envoyers par mail.

Je ne sais pas si je suis suffisamment clair, et j'espère ne pas partir dans des plans incroyable !

L'objectif de la macro est d'envoyé des mails à la suite les uns des autres, avec dedans un contenus différents, en fonction de la colonne C (je n'envoi pas à Alan, les données de Tom). Pour cela il faut que j'arrive à faire une "sélection incrémental", envoyer un email, "continuer ma sélection incrémentale" à la suite de la dernière, envoyer un email, etc... jusqu'à ce que la ligne soit vide !

P.S: en bonus, faire un "union" de ma selection avec la ligne C3 dans le mail...

J'ai tout essayé de ce que je trouvais sur internet, en essayant de le remettre à ma sauce, des if/end if, des while/wend, des do, des loops, for i = 4 to 1000, next it, enfin bref.... tout ce qui m'est accessible; mais comme je manque de pratique et des règles de typos, je n'y arrive pas....

A l'aide !

Encore une fois, un grand merci à ceux qui prendront le temps de me donner un coup de main....

Merci.

Bonjour,

Bonjour Raja,

Désolé, je pensais que ça serait plus simple sans (mais avec du recul, c'est pas forcément vrai...).

J'ai rajouté un document en pièce jointe (dans ce message, et dans celui d'origine).

C'est le fichier que j'utilise pour mon boulot.

Du coup, il y a déjà 4 macro que j'ai et qui fonctionne bien... deux "correctives" (date issues & logical issues), une pour importer les données (importorcleansing), et enfin le mail (que j'ai finis hier aprem...).

Si ça peut servir à quelqu'un d'autre ! (pas peu fier du "mail" ou de l"import" ^^ !).

Me reste donc simplement, celle du "select" pour laquelle j'ai besoin d'aide....

EDIT: J'ai mis une sorte "d'explication" sur la droite du tableau; onglet "Inconsistencies".

Merci encore !

Bonjour,

Essaie ceci :

Sub select_test()
    Dim i%, L1%, L2%
    With Worksheets("Inconsistencies")
        For i = 4 To .Cells(.Rows.Count, 3).End(xlUp).Row
            L1 = i: L2 = i
            Do While .Cells(i + 1, 3) = .Cells(i, 3)
                i = i + 1: L2 = i
            Loop
            Union(.Range("C3:F3"), .Range("C" & L1 & ":F" & L2)).Select

            'collage pour la démo, à remplacer par ton code
            j = j + 10
            Selection.Copy .Cells(j + i, 3)

        Next i
    End With
End Sub

J'effectue un collage des 3 plages en-dessous et espacées pour que tu voies le résultat. C'est à remplacer par ton code d'expédition.

Cordialement.

Hello,

Je test ça tout de suite, et je te dis ! (Edit à venir).

edo

EDIT: Re ! Alors la, la situation est assez étrange. Si je prends ton code seul, ça fonctionne... Si je le merge dans l'envoi d'email (qui fonctionne aussi), ça ne va plus sur une de tes instructions:

For i = 4 to .Cells(.rows.count, 3).end(xlUp) .row

me renvoi une erreur sur le premier .rows: "membre de méthode ou de données introuvable"

une idée ? (p.s: ci-dessous le code "modifié").

Merci !

EDIT2: J'ai enlevé tout les . devant Rows, Range, etc... ça à l'air de "tourner", par contre, aucun mail ne part; et ma selection descend tout en bas (jusqu'à avant une ligne vide)...

EDIT3: Bon... en ne changeant rien, finalement il me fait bien une selection coup par coup. Par contre, malgré mon "autorisation" d'envoi (ce prompt outlook qui demande une validation), rien ne pars. Pas certain que l'erreur viennent du code cette fois.

EDIT4: Bon, j'ai réussis à faire marcher ce code à force de bidouillage. Mille merci pour ton aide. Je n'aurai vraiment pas réussis sans ça ! Encore merci pour tout.

Par contre, en tant que néophyte, c'est vrai que je ne saisis pas tout à ton code... tu pourrais m'en expliquer la 'logique ? Si trop long, je comprendrai

Sub mail()

Dim Olapp As Outlook.Application
Dim MItem As Outlook.MailItem
Dim cell As Range
Dim Projet, EmailAddr, EmailAddrCC, Msg, Subj As String
Dim TEXTE_AVANT, TEXTE_APRES, FACTURE As String
Dim i%, L1%, L2%

TEXTE_AVANT = Sheets("TCD").Range("M40")
TEXTE_APRES = Sheets("TCD").Range("M45")
FACTURE = Sheets("TCD").Range("M50")
EmailAddr = "test"
    'EmailAddr = Sheets("Feuil1").Range("B24")
EmailAddrCC = " test "
    'EmailAddrCC = Sheets("Feuil1").Range("B25")
Subj = Sheets("TCD").Range("M55")

Sheets("Inconsistencies").Select

Set OutlookApp = New Outlook.Application

        Msg = Msg & TEXTE_AVANT
        Msg = Msg & "Solde :" & FACTURE & "." & vbCrLf '& vbCrLf

With Worksheets
    For i = 4 To .Cells(.Rows.Count, 3).End(xlUp).Row
        L1 = i: L2 = i
        Do While .Cells(i + 1, 3) = .Cells(i, 3)
            i = i + 1: L2 = i
        Loop
        ActiveSheet.Union(.Range("C3:F3"), .Range("C" & L1 & ":F" & L2)).Select

        ActiveWorkbook.EnvelopeVisible = True
        Selection.Copy

        Msg = Msg & vbCrLf
        Msg = Msg & TEXTE_APRES & vbCrLf
        Msg = Msg & vbCrLf
        Msg = Msg & "Cordialement" & vbCrLf
        Msg = Msg & "Nom" & vbCrLf
        Msg = Msg & "Poste" & vbCrLf
        Msg = Msg & vbCrLf

        With ActiveSheet.MailEnvelope
            .Introduction = Msg
            .Item.To = EmailAddr
            .Item.CC = EmailAddrCC
            .Item.Subject = Subj
            .Item.Display
            '.Item.Send
        End With

        Set MItem = OutlookApp.CreateItem(olMailItem)
    Next i
End With

End Sub