Sélection dernière ligne remplie d'une colonne variable

Bonjour,

je viens de nouveau solliciter votre aide et vos compétences...

je souhaiterai récupérer la ligne de la dernière cellule renseignée mais d'une colonne dont l'emplacement change. La colonne peut-être la C, R, ZT.... ce n'ai jamais la même.

J'utilise ce code:

For Each x In Range("A2:ZZ2")

If x = "/debut" Then x.Offset(1, 0).Activate

Range(Selection, Selection.End(xlDown)).Select
Next

ce qui me sélectionne tout jusqu'à la dernière ligne renseignée. (pas de cellule vide entre la première et la dernière)

J'aimerais donc remplacer

Selection.End(xlDown)

par une dernière ligne d'une colonne aléatoire (qui n'est bien sur pas la meme dernière ligne que la colonne contenant /debut...)

J'arrive à récupérer le numéro de la colonne concernée grâce à la méthode FIND (qui m'active une cellule) et ActiveCell.Column

Je mets ce résultat en variable

rr = ActiveCell.Column

et je fais:

DL = Range(column(rr) & Rows.Count).End(xlUp).Row 

mais cela ne marche pas...

peut etre à cause de ça:

If x = "/debut" Then x.Offset(1, 0).Activate

car j'active et non sélectionne? Mais si je mets .Select mon programme plante.

Merci de votre aide encore une fois....

Cordialement,

Innuendo67

Bonjour Innuendo, bonjour le forum,

Essaie comme ça :

rr = ActiveCell.Column
DL = Cells(Application.Rows.Count, rr).End(xlUp).Row

Bonjour ThauTheme,

J'ai un message d'erreur sur ta ligne: Erreur d'exécution 1004: erreur définie par l'application ou par l'objet.

Merci de ta réponse !

Cordialement

Innuendo67

De plus, en mettant une colonne fixe, j'ai une erreur plus loin :

Range(Selection & DL).Select

Merci encore...

Innuendo67

Bonsoir innuendo, bonsoir le forum,

Il est très difficile de travailler sur des bouts de code hors du contexte ! Sans le fichier qui va bien je ne peux pas t'aider davantage. Ta ligne de code :

Range(Selection & DL).Select

n'est pas cohérente. Selection représente un objet de type Range lui-même (une cellule ou une plage de cellules). Soit tu utilises la méthode A1 soit la méthode L1C1 et, en fonction de ce que représente Selection, le code pourrait être :

• Selection est une cellule unique

Selection.End(xlDown).Select
Selection.End(xlUp).select
Cells(Application.Rows.Count, Selection.Column).End(xlUp).Select
Cells(1, Selection.Column).End(xlDown).Select

• Selection est une plage de cellules

Selection.SpecialCells(xlCellTypeLastCell).Select

Et il y aurait encore bien d'autres possibilités ! L'idéal est d'en connaître le maximum pour utiliser celle qui convient le mieux selon le cas mais pour cela il faut le fichier...

Bonjour TauThème et merci de t'attarder sur mon projet!

Voici un bout du code concerné sachant que le reste est du même acabit:

Dim DernLigne As Long
Dim repertoiredeFICHIERSaimporter As String
Dim wb As Workbook
Dim x As Range
Dim J As Long

repertoiredeFICHIERSaimporter = ActiveWorkbook.Path & "\FICHIERS A TRAITER"

monfichier = Dir(repertoiredeFICHIERSaimporter & "\FICHIER*.xml")
While monfichier <> ""

Cells(Rows.Count, 1).End(xlUp)(2).Select

    Workbooks.OpenXML Filename:=repertoiredeFICHIERSaimporter & "\" & monfichier
   If monfichier = False Then Exit Sub

   DernLigne = Range("BF" & Rows.Count).End(xlUp).Row

For Each x In Range("A2:ZZ2")

If x = "commentaire/texte" Then x.Offset(1, 0).Activate

Range(Selection, Selection.End(xlDown)).Select
Next

    Selection.Copy

    Windows("Récupération.xlsm").Activate
    Cells(Rows.Count, 2).End(xlUp)(2).Select

    ActiveSheet.Paste

    For Each wb In Workbooks
        If UCase(wb.Name) Like "FICHIER*" Then wb.Activate: Exit For
    Next wb

   DernLigne = Range("BF" & Rows.Count).End(xlUp).Row

For Each x In Range("A2:ZZ2")

If x = "pierre/texte" Then x.Offset(1, 0).Activate
Range(Selection, Selection.End(xlDown)).Select
Next
    Selection.Copy

    Windows("Récupération.xlsm").Activate
    Cells(Rows.Count, 5).End(xlUp)(2).Select

    ActiveSheet.Paste

Ce code fonctionne sauf que je souhaiterais remplacer le

Range(Selection, Selection.End(xlDown)).Select

par une fin de ligne d'une colonne variable.

En gros, sélection de la plage de la cellule du dessous contenant "pierre/texte", jusqu'à la dernière ligne renseignée de la colonne contenant "surveillance" . Toutes ces colonnes ne sont pas fixes c'est pour cela que je recherche l'intitulé de la colonne.

Je ne sais pas si je suis clair!

Merci encore!

Cordialement,

Innuendo67

Bonsoir Innuendo, bonsoir le forum,

Il faut absolument éviter les Select qui ne font que ralentir l'exécution du code !...

Voilà comment je verrais les choses (désolé j'ai remplacé le nom à rallonge de tes variables) :

Sub Macro1()
Dim CLR As Workbook 'déclare la variable CLR (CLasseur Receveur)
Dim ONR As Worksheet 'déclare la variable ONR (ONglet Receveur)
Dim CH As String 'déclare la variable CH (Chemin d'accès)
Dim F As String 'déclare la variable F (Fichier)
Dim CLD As Workbook 'déclare la variable CLD (CLasseur Donneur)
Dim OND As Worksheet 'déclare la variable OND (ONglet Donneur)
Dim R1 As Range 'déclare la variable R1 (Recherche 1)
Dim R2 As Range 'déclare la variable R2 (Recherche 2)
Dim COL As Integer 'déclare la variable COL (COLonne)
'Dim DL As Long 'déclare la variable DL (Dernière Ligne)

Set CLR = ThisWorkbook 'définit le classeur receveur CLR
Set ONR = CLR.ActiveSheet 'définit l'onglet receveur ONR (à adapter, je préfère le nommer en dur...)
CH = CLR.Path & "\FICHIERS A TRAITER\" 'définit le chemin d'accès CH
F = Dir(CH & "FICHIER*.xml") 'définit le fichier F
While F <> ""
    Workbooks.OpenXML Filename:=CH & F 'ouvre le fichier F
    If F = False Then Exit Sub 'sort de la procédure si pas de fichier correspondant
    Set CLD = ActiveWorkbook 'définit la classeur donneur CLD
    Set OND = CLD.sheets(1) 'définit l'onglet donneur OND (à adapter)
    'DL = ONR.Range("BF" & Rows.Count).End(xlUp).Row 'je ne vois pas l'utilité de cette variable !
    'définit la recherche R (recherche le texte : "commentaire/texte" dans la ligne 2 de l'onglet OND )
    Set R1 = OND.Rows(2).Find("commentaire/texte", , xlValues, xlWhole)
    If Not R1 Is Nothing Then 'condition : si au moins une occurrence est trouvée
        COL = R1.Column 'définit la colonne COL de la première occurrence trouvée
        'copie les cellules éditées de la colonne col (à partir de la troisième ligne) et les colle
        'dans la première ligne vide de la colonne 2 (=B) de l'onglet ONR
        OND.Range(OND.Cells(3, COL), OND.Cells(Application.Rows.Count, COL).End(xlUp)).Copy _
            ONR.Cells(Application.Rows.Count, 2).End(xlUp).Offset(1, 0)
    End If 'fin de la condition
    'redéfinit la recherche R (recherche le texte : "pierre/texte" dans la ligne 2 de l'onglet OND )
    Set R2 = OND.Rows(2).Find("pierre/texte", , xlValues, xlWhole)
    If Not R2 Is Nothing Then 'condition : si au moins une occurrence est trouvée
        COL = R2.Column 'définit la colonne COL de la première occurrence trouvée
        'copie les cellules éditées de la colonne col (à partir de la troisième ligne) et les colle
        'dans la première ligne vide de la colonne 5 (=E) de l'onglet ONR
        OND.Range(OND.Cells(3, COL), OND.Cells(Application.Rows.Count, COL).End(xlUp)).Copy _
            ONR.Cells(Application.Rows.Count, 5).End(xlUp).Offset(1, 0)
    End If
Wend
End Sub

À adapter à ton cas pour le nom des onglets...

Bonjour TauThème et merci encore pour ton attention,

ton code fonctionne mais comme le mien...

Par contre, il n'ouvre qu'un fichier même s'il y en a plusieurs dans le dossier FICHIERS A TRAITER.

Ton code tourne en boucle sur le premier fichier trouvé, je dois faire ECHAP pour sortir de la macro.

Sur mon code je mets un

ActiveWindow.Close

entre le dernier copy et le dernier coller.

Sur ton code

 OND.Range(OND.Cells(3, COL), OND.Cells(Application.Rows.Count, COL).End(xlUp)).Copy _
            ONR.Cells(Application.Rows.Count, 5).End(xlUp).Offset(1, 0)

Je n'y parviens pas.

De plus, en restant sur ton code en exemple, le range de

R2.Columns

a une dernière ligne dans cette colonne. Mais mon souci c'est que la dernière ligne de R2 à prendre en compte est celle de R1. Je ne sais pas si je suis clair...

Ton

If F = False Then Exit Sub

bug chez moi.

Je te remercie de toute ton attention et m'excuse de ces demandes répétées mais je bloque sur cette dernière ligne variable...

Cordialement,

Innuendo67

Bonjour Innuendo, bonjour le forum,

Innuendo67 a écrit :

il n'ouvre qu'un fichier même s'il y en a plusieurs dans le dossier FICHIERS A TRAITER.

Je n'ai fait que reprendre ton code dans lequel il manquait F = Dir pour boucler sur tous les fichiers...

Innuendo67 a écrit :

Sur ton code

 OND.Range(OND.Cells(3, COL), OND.Cells(Application.Rows.Count, COL).End(xlUp)).Copy _
            ONR.Cells(Application.Rows.Count, 5).End(xlUp).Offset(1, 0)

Je n'y parviens pas.

Tu ne parviens pas à quoi ???

Innuendo67 a écrit :

De plus, en restant sur ton code en exemple, le range de

R2.Columns

a une dernière ligne dans cette colonne. Mais mon souci c'est que la dernière ligne de R2 à prendre en compte est celle de R1. Je ne sais pas si je suis clair...

Il suffit de supprimer la ligne de la seconde définition de la variable COL !

Innuendo67 a écrit :

Ton

If F = False Then Exit Sub

bug chez moi.

Ça fait partie de ton code !...

Comme je t'ai dit lors de ma seconde réponse, sans fichier il est difficile de comprendre et par conséquent pouvoir te dépanner. Donc, si tu ne daignes toujours pas mettre ton fichier, ou un fichier exemple reprenant la structure de ton fichier, je ne reviendrai plus sur ton fil...

Le code modifié :

    Sub Macro1()
    Dim CLR As Workbook 'déclare la variable CLR (CLasseur Receveur)
    Dim ONR As Worksheet 'déclare la variable ONR (ONglet Receveur)
    Dim CH As String 'déclare la variable CH (Chemin d'accès)
    Dim F As String 'déclare la variable F (Fichier)
    Dim CLD As Workbook 'déclare la variable CLD (CLasseur Donneur)
    Dim OND As Worksheet 'déclare la variable OND (ONglet Donneur)
    Dim R1 As Range 'déclare la variable R1 (Recherche 1)
    Dim R2 As Range 'déclare la variable R2 (Recherche 2)
    Dim COL As Integer 'déclare la variable COL (COLonne)
    'Dim DL As Long 'déclare la variable DL (Dernière Ligne)

    Set CLR = ThisWorkbook 'définit le classeur receveur CLR
    Set ONR = CLR.ActiveSheet 'définit l'onglet receveur ONR (à adapter, je préfère le nommer en dur...)
    CH = CLR.Path & "\FICHIERS A TRAITER\" 'définit le chemin d'accès CH
    F = Dir(CH & "FICHIER*.xml") 'définit le fichier F (premier fichier de la liste)
    While F <> ""
        Workbooks.OpenXML Filename:=CH & F 'ouvre le fichier F
       If F = False Then Exit Sub 'sort de la procédure si pas de fichier correspondant
       Set CLD = ActiveWorkbook 'définit la classeur donneur CLD
       Set OND = CLD.Sheets(1) 'définit l'onglet donneur OND (à adapter)
       'DL = ONR.Range("BF" & Rows.Count).End(xlUp).Row 'je ne vois pas l'utilité de cette variable !
       'définit la recherche R (recherche le texte : "commentaire/texte" dans la ligne 2 de l'onglet OND )
       Set R1 = OND.Rows(2).Find("commentaire/texte", , xlValues, xlWhole)
        If Not R1 Is Nothing Then 'condition : si au moins une occurrence est trouvée
           COL = R1.Column 'définit la colonne COL de la première occurrence trouvée
           'copie les cellules éditées de la colonne col (à partir de la troisième ligne) et les colle
           'dans la première ligne vide de la colonne 2 (=B) de l'onglet ONR
           OND.Range(OND.Cells(3, COL), OND.Cells(Application.Rows.Count, COL).End(xlUp)).Copy _
                ONR.Cells(Application.Rows.Count, 2).End(xlUp).Offset(1, 0)
        End If 'fin de la condition
       'redéfinit la recherche R (recherche le texte : "pierre/texte" dans la ligne 2 de l'onglet OND )
       Set R2 = OND.Rows(2).Find("pierre/texte", , xlValues, xlWhole)
        If Not R2 Is Nothing Then 'condition : si au moins une occurrence est trouvée
           'copie les cellules éditées de la colonne col (à partir de la troisième ligne) et les colle
           'dans la première ligne vide de la colonne 5 (=E) de l'onglet ONR
           OND.Range(OND.Cells(3, COL), OND.Cells(Application.Rows.Count, COL).End(xlUp)).Copy _
                ONR.Cells(Application.Rows.Count, 5).End(xlUp).Offset(1, 0)
        End If
        CLD.Close False 'ferme le classeur Donneur sans l'enregistrer
        F = Dir 'redéfinit le fichier F (fichier suivant)
    Wend
    End Sub

Bonjour TauThème,

merci de ta réponse.

Je ne peux malheureusement pas te donner un fichier car ils sont sensibles.

J'ai fait en revanche un fichier reprenant mon souci détaillé.

Le

F = Dir()

je l'avais oublié dans ma recopie...

Le

    If F = False Then Exit Sub

convient très bien dans mon code de base mais plus avec le tien. Ce n'est pas grave.

Le fait de supprimer la définition de la variable de la première ligne comme tu le proposes ne changes rien.

Je mets en fichier mon exemple plus clair.

Je te remercie de toute l'attention que tu portes à mon souci.

Cordialement,

Innuendo67.

Re,

Je pense avoir mieux compris. Regarde ce nouveau code.

Il recherche la colonne où il y a commentaire/texte. Si il trouve, il définit la colonne COL et la dernière ligne éditée DL de cette colonne. Il recherche ensuite pierre/texte. Si il trouve, il redéfinit la colonne COL, il copie les lignes 3 à DL de cette colonne et les colle dans la première cellule vide de la colonne E de l'onglet ONR :

Sub Macro1()
Dim CLR As Workbook 'déclare la variable CLR (CLasseur Receveur)
Dim ONR As Worksheet 'déclare la variable ONR (ONglet Receveur)
Dim CH As String 'déclare la variable CH (Chemin d'accès)
Dim F As String 'déclare la variable F (Fichier)
Dim CLD As Workbook 'déclare la variable CLD (CLasseur Donneur)
Dim OND As Worksheet 'déclare la variable OND (ONglet Donneur)
Dim R1 As Range 'déclare la variable R1 (Recherche 1)
Dim R2 As Range 'déclare la variable R2 (Recherche 2)
Dim COL As Integer 'déclare la variable COL (COLonne)
'Dim DL As Long 'déclare la variable DL (Dernière Ligne)

Set CLR = ThisWorkbook 'définit le classeur receveur CLR
Set ONR = CLR.ActiveSheet 'définit l'onglet receveur ONR (à adapter, je préfère le nommer en dur...)
CH = CLR.Path & "\FICHIERS A TRAITER\" 'définit le chemin d'accès CH
F = Dir(CH & "FICHIER*.xml") 'définit le fichier F (premier fichier de la liste)
While F <> ""
    Workbooks.OpenXML Filename:=CH & F 'ouvre le fichier F
    If F = False Then Exit Sub 'sort de la procédure si pas de fichier correspondant
    Set CLD = ActiveWorkbook 'définit la classeur donneur CLD
    Set OND = CLD.Sheets(1) 'définit l'onglet donneur OND (à adapter)
    'DL = ONR.Range("BF" & Rows.Count).End(xlUp).Row 'je ne vois pas l'utilité de cette variable !
    'définit la recherche R (recherche le texte : "commentaire/texte" dans la ligne 2 de l'onglet OND )
    Set R1 = OND.Rows(2).Find("commentaire/texte", , xlValues, xlWhole)
    If Not R1 Is Nothing Then 'condition : si au moins une occurrence est trouvée
        COL = R1.Column 'définit la colonne COL de la première occurrence trouvée
        DL = OND.Cells(Application.Rows.Count, COL).End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne COL de l'onget OND
    End If 'fin de la condition
    'redéfinit la recherche R (recherche le texte : "pierre/texte" dans la ligne 2 de l'onglet OND )
    Set R2 = OND.Rows(2).Find("pierre/texte", , xlValues, xlWhole)
    If Not R2 Is Nothing Then 'condition : si au moins une occurrence est trouvée
        'copie les cellules éditées de la colonne col (à partir de la troisième ligne) et les colle
        'dans la première ligne vide de la colonne 5 (=E) de l'onglet ONR
        OND.Range(OND.Cells(3, COL), OND.Cells(DL, COL)).Copy _
        ONR.Cells(Application.Rows.Count, 5).End(xlUp).Offset(1, 0)
    End If
    CLD.Close False 'ferme le classeur Donneur sans l'enregistrer
    F = Dir 'redéfinit le fichier F (fichier suivant)
Wend
End Sub

Merci TauTheme,

Impeccable sauf qu'il me copie également la cellule contenant l'en-tête de colonne contrairement à ton code de départ.

J'ai essayé un offset sans succès...

Merci encore!

Cordialement,

Innuendo67

Bonjour TauThème,

je ne parviens toujours pas à comprendre pourquoi le code m'inclut la cellule d'en-tête. Toutes les autres copies se font normalement sauf celle où il y a la fameuse DL...

[code][/OND.Range(OND.Cells(3, COL), OND.Cells(DL, COL)).Copy _

ONR.Cells(Application.Rows.Count, 5).End(xlUp).Offset(1, 0)code]

J'ai essayé de modifier le (3,COL) en 2 ou autre mais sans succès...

Aurais-tu une solution?

Désolé de te déranger encore avec ceci...

Merci.

Cordialement,

Innuendo67

Bonjour Innuendo, bonjour le forum,

Si la cellule d'en-tête se trouve dans la ligne 3 alors il faut utiliser une ligne en dessous, soit la ligne 4 !

[/OND.Range(OND.Cells(4, COL), OND.Cells(DL, COL)).Copy _
ONR.Cells(Application.Rows.Count, 5).End(xlUp).Offset(1, 0)

Bonjour TauTheme,

J'ai évidemment déjà tenté tout ça. 2,3,4....

Sur mon OND toutes les en-têtes sont en ligne 3, c'est pourquoi je ne sais pas pourquoi il bug ici

Et pas ailleurs...

Dans mon fichier d'origine, il n'y a que la ligne

4 et 5 à copier (nbe variable) . Ton code le fait partout sauf avec la variable DL...

Je ne comprends pas...

Cordialement

Innuendo67

Bonjour Innuendo, bonjour le forum,

Le code est suffisamment rigoureux en spécifiant chaque fois le nom de l'onglet ! Donc le problème est ailleurs...

Bonjour TauThème,

je joints mon code entier au cas où tu verrais quelque chose de pas normal...

Application.ScreenUpdating = False

Dim CLR As Workbook 'déclare la variable CLR (CLasseur Receveur)
    Dim ONR As Worksheet 'déclare la variable ONR (ONglet Receveur)
    Dim CH As String 'déclare la variable CH (Chemin d'accès)
    Dim F As String 'déclare la variable F (Fichier)
    Dim CLD As Workbook 'déclare la variable CLD (CLasseur Donneur)
    Dim OND As Worksheet 'déclare la variable OND (ONglet Donneur)
    Dim R1 As Range 'déclare la variable R1 (Recherche 1)
    Dim R2 As Range 'déclare la variable R2 (Recherche 2)
    Dim R3 As Range 'déclare la variable R2 (Recherche 3)
    Dim R4 As Range 'déclare la variable R2 (Recherche 4)
    Dim R5 As Range 'déclare la variable R2 (Recherche 5)
    Dim R6 As Range 'déclare la variable R2 (Recherche 6)
    Dim R7 As Range 'déclare la variable R2 (Recherche 7)
    Dim R8 As Range 'déclare la variable R2 (Recherche 8)
    Dim R9 As Range 'déclare la variable R2 (Recherche 9)
    Dim COL As Integer 'déclare la variable COL (COLonne)
    Dim COL2 As Integer 'déclare la variable COL2 (COLonne)
    Dim DL As Long 'déclare la variable DL (Dernière Ligne)

    Set CLR = ThisWorkbook 'définit le classeur receveur CLR
    Set ONR = CLR.ActiveSheet 'définit l'onglet receveur ONR (à adapter, je préfère le nommer en dur...)
    CH = CLR.Path & "\FICHIERS A TRAITER\" 'définit le chemin d'accès CH
    F = Dir(CH & "FICHIER*.xml") 'définit le fichier F
    While F <> ""
        Workbooks.OpenXML Filename:=CH & F 'ouvre le fichier F
       'If F = False Then Exit Sub 'sort de la procédure si pas de fichier correspondant
       Set CLD = ActiveWorkbook 'définit la classeur donneur CLD
       Set OND = CLD.Sheets(1) 'définit l'onglet donneur OND (à adapter)

       'définit la recherche R (recherche le texte : "commentaire/texte" dans la ligne 2 de l'onglet OND )
       Set R1 = OND.Rows(2).Find("/texte", , xlValues, xlWhole)
        If Not R1 Is Nothing Then 'condition : si au moins une occurrence est trouvée
           COL = R1.Column 'définit la colonne COL de la première occurrence trouvée
           'copie les cellules éditées de la colonne col (à partir de la troisième ligne) et les colle
           'dans la première ligne vide de la colonne 2 (=B) de l'onglet ONR
           OND.Range(OND.Cells(3, COL), OND.Cells(Application.Rows.Count, COL).End(xlUp)).Copy _
                ONR.Cells(Application.Rows.Count, 2).End(xlUp).Offset(1, 0)
        End If 'fin de la condition
       'redéfinit la recherche R (recherche le texte : "pierre/texte" dans la ligne 2 de l'onglet OND )
       Set R2 = OND.Rows(2).Find("/pierre/texte", , xlValues, xlWhole)
        If Not R2 Is Nothing Then 'condition : si au moins une occurrence est trouvée
           COL = R2.Column 'définit la colonne COL de la première occurrence trouvée
           'copie les cellules éditées de la colonne col (à partir de la troisième ligne) et les colle
           'dans la première ligne vide de la colonne 5 (=E) de l'onglet ONR
           OND.Range(OND.Cells(3, COL), OND.Cells(Application.Rows.Count, COL).End(xlUp)).Copy _
                ONR.Cells(Application.Rows.Count, 5).End(xlUp).Offset(1, 0)
        End If
        ''''''''''

        Set R3 = OND.Rows(2).Find("/origine", , xlValues, xlWhole)
        If Not R3 Is Nothing Then 'condition : si au moins une occurrence est trouvée
           COL = R3.Column 'définit la colonne COL de la première occurrence trouvée
           'copie les cellules éditées de la colonne col (à partir de la troisième ligne) et les colle
           'dans la première ligne vide de la colonne 5 (=E) de l'onglet ONR
           OND.Range(OND.Cells(3, COL), OND.Cells(Application.Rows.Count, COL).End(xlUp)).Copy _
                ONR.Cells(Application.Rows.Count, 4).End(xlUp).Offset(1, 0)
        End If

        Set R4 = OND.Rows(2).Find("/paris", , xlValues, xlWhole)
        If Not R4 Is Nothing Then 'condition : si au moins une occurrence est trouvée
           COL = R4.Column 'définit la colonne COL de la première occurrence trouvée
           'copie les cellules éditées de la colonne col (à partir de la troisième ligne) et les colle
           'dans la première ligne vide de la colonne 5 (=E) de l'onglet ONR
           OND.Range(OND.Cells(3, COL), OND.Cells(Application.Rows.Count, COL).End(xlUp)).Copy _
                ONR.Cells(Application.Rows.Count, 9).End(xlUp).Offset(1, 0)
        End If

       Set R5 = OND.Rows(2).Find("/strasbourg", , xlValues, xlWhole)
        If Not R5 Is Nothing Then 'condition : si au moins une occurrence est trouvée
           COL = R5.Column 'définit la colonne COL de la première occurrence trouvée
           'copie les cellules éditées de la colonne col (à partir de la troisième ligne) et les colle
           'dans la première ligne vide de la colonne 5 (=E) de l'onglet ONR
           OND.Range(OND.Cells(3, COL), OND.Cells(Application.Rows.Count, COL).End(xlUp)).Copy _
                ONR.Cells(Application.Rows.Count, 3).End(xlUp).Offset(1, 0)
        End If

        Set R6 = OND.Rows(2).Find("/oslo", , xlValues, xlWhole)
        If Not R6 Is Nothing Then 'condition : si au moins une occurrence est trouvée
           COL = R6.Column 'définit la colonne COL de la première occurrence trouvée
           'copie les cellules éditées de la colonne col (à partir de la troisième ligne) et les colle
           'dans la première ligne vide de la colonne 5 (=E) de l'onglet ONR
           OND.Range(OND.Cells(3, COL), OND.Cells(Application.Rows.Count, COL).End(xlUp)).Copy _
                ONR.Cells(Application.Rows.Count, 10).End(xlUp).Offset(1, 0)
        End If

       Set R7 = OND.Rows(2).Find("/niamey", , xlValues, xlWhole)
        If Not R7 Is Nothing Then 'condition : si au moins une occurrence est trouvée
           COL = R7.Column 'définit la colonne COL de la première occurrence trouvée
           'copie les cellules éditées de la colonne col (à partir de la troisième ligne) et les colle
           'dans la première ligne vide de la colonne 5 (=E) de l'onglet ONR
           OND.Range(OND.Cells(3, COL), OND.Cells(Application.Rows.Count, COL).End(xlUp)).Copy _
                ONR.Cells(Application.Rows.Count, 8).End(xlUp).Offset(1, 0)
        End If

        Set R9 = OND.Rows(2).Find("/strasbourg", , xlValues, xlWhole)
        If Not R9 Is Nothing Then 'condition : si au moins une occurrence est trouvée
           COL2 = R9.Column 'définit la colonne COL de la première occurrence trouvée
           DL = OND.Cells(Application.Rows.Count, COL2).End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne COL de l'onget OND
       End If 'fin de la condition

        Set R8 = OND.Rows(2).Find("/xxxx", , xlValues, xlWhole)
        If Not R8 Is Nothing Then 'condition : si au moins une occurrence est trouvée
           COL = R8.Column 'définit la colonne COL de la première occurrence trouvée
           'copie les cellules éditées de la colonne col (à partir de la troisième ligne) et les colle
           'dans la première ligne vide de la colonne 5 (=E) de l'onglet ONR

           OND.Range(OND.Cells(5, COL), OND.Cells(DL, COL).End(xlUp)).Copy _
                ONR.Cells(Application.Rows.Count, 11).End(xlUp).Offset(1, 0)
        End If
     CLD.Close
    F = Dir()
    Wend

  CLR.Activate

   DernLigne = Range("H" & Rows.Count).End(xlUp).Row
For Each x In Range("B2:E" & DernLigne)
If x = "" Then x = "[---]"
Next

 DernLigne = Range("H" & Rows.Count).End(xlUp).Row
For Each x In Range("H2:K" & DernLigne)
If x = "" Then x = "[---]"
Next

End Sub

Je te remercie encore.

Cordialement,

Innuendo67

Re,

Pas envie, Innuendo, de recréer un fichier avec ton environnement pour tester ton code. Encore plus la flemme que toi...

Mais il faut que tu comprennes que si une colonne ne contient aucune autre données (à part l'en-tête), la ligne de code :

OND.Range(OND.Cells(2, COL), OND.Cells(Application.Rows.Count, COL).End(xlUp))

va sélectionner cet en-tête puisque elle sélectionne à partir de la ligne 2 jusqu'à la première ligne non vide en partant de la fin qui équivaut à 2. Donc des lignes 2 à... 2. Si ton problème se situe là, il faut que tu rajoutes une condition pour vérifier la valeur de la cellule en dessous. Ça donnerait :

If Not R1 Is Nothing And R1.Offset(1, 0) <> "" Then