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