Copier coller des cellules visibles excel dans email
Résolu/Fermé
solidarinfo
Messages postés
147
Date d'inscription
jeudi 26 mars 2009
Statut
Membre
Dernière intervention
8 décembre 2021
-
Modifié par solidarinfo le 8/06/2016 à 13:05
solidarinfo Messages postés 147 Date d'inscription jeudi 26 mars 2009 Statut Membre Dernière intervention 8 décembre 2021 - 21 juin 2016 à 10:30
solidarinfo Messages postés 147 Date d'inscription jeudi 26 mars 2009 Statut Membre Dernière intervention 8 décembre 2021 - 21 juin 2016 à 10:30
A voir également:
- Copier uniquement les cellules visibles google sheet
- Google maps satellite - Guide
- Dns google - Guide
- Google maps - Guide
- Google - Guide
- Créer un compte google - Guide
6 réponses
f894009
Messages postés
17239
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
10 février 2025
1 713
8 juin 2016 à 14:43
8 juin 2016 à 14:43
Bonjour,
Avez-vous regardez ici,
https://www.rondebruin.nl/win/s1/outlook/bmail2.htm
Avez-vous regardez ici,
https://www.rondebruin.nl/win/s1/outlook/bmail2.htm
solidarinfo
Messages postés
147
Date d'inscription
jeudi 26 mars 2009
Statut
Membre
Dernière intervention
8 décembre 2021
13
8 juin 2016 à 16:39
8 juin 2016 à 16:39
Bonjour f894009,
Merci pour ta réponse.
En fait, c'est ce que j'ai fait en gros dans ma macro. Ce que je n'arrive pas à comprendre c'est pourquoi cela ne colle pas dans le corps du texte. Je ne sais pas si mon code est 100% juste à priori non mais je ne sais pas ou ça déconne..
Merci pour ta réponse.
En fait, c'est ce que j'ai fait en gros dans ma macro. Ce que je n'arrive pas à comprendre c'est pourquoi cela ne colle pas dans le corps du texte. Je ne sais pas si mon code est 100% juste à priori non mais je ne sais pas ou ça déconne..
f894009
Messages postés
17239
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
10 février 2025
1 713
8 juin 2016 à 16:48
8 juin 2016 à 16:48
Re,
C'est le "en gros" qui pose problème, je ne vois pas cette fonction
qui justement traite ce que le "en gros" ne fait pas et qui est appelée par
C'est le "en gros" qui pose problème, je ne vois pas cette fonction
Function RangetoHTML(rng As Range)
qui justement traite ce que le "en gros" ne fait pas et qui est appelée par
.HTMLBody = RangetoHTML(rng)
solidarinfo
Messages postés
147
Date d'inscription
jeudi 26 mars 2009
Statut
Membre
Dernière intervention
8 décembre 2021
13
8 juin 2016 à 18:42
8 juin 2016 à 18:42
Re,
Du coup j'ai du réorganiser le code j'ai mis un lien vers une cellule pour lire automatiquement le texte avec le montant que je veux faire apparaitre dedans (au lieu de créer un code spécifique) :
With OutMail
.To = "=anne.b@fr.com" 'destinataire(s)
.CC = "ab@fr.com" ' copie
.Subject = "Validation de ton équipe" ' Sujet
.HTMLbody = Sheet2.Range("Y1")
Mais à chaque fois que j'arrive sur cette ligne ca bloque et j'arrive pas à debuger.
Du coup j'ai du réorganiser le code j'ai mis un lien vers une cellule pour lire automatiquement le texte avec le montant que je veux faire apparaitre dedans (au lieu de créer un code spécifique) :
With OutMail
.To = "=anne.b@fr.com" 'destinataire(s)
.CC = "ab@fr.com" ' copie
.Subject = "Validation de ton équipe" ' Sujet
.HTMLbody = Sheet2.Range("Y1")
Mais à chaque fois que j'arrive sur cette ligne ca bloque et j'arrive pas à debuger.
f894009
Messages postés
17239
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
10 février 2025
1 713
8 juin 2016 à 19:08
8 juin 2016 à 19:08
Re,
Et y a quoi comme erreur ????????????????????????????
Et y a quoi comme erreur ????????????????????????????
solidarinfo
Messages postés
147
Date d'inscription
jeudi 26 mars 2009
Statut
Membre
Dernière intervention
8 décembre 2021
13
8 juin 2016 à 19:54
8 juin 2016 à 19:54
Re,
Il n' ya pas d'erreur a ce niveau, cela me sort juste l'email avec le corps du message sans copier coller les infos du tableau excel.
Il n' ya pas d'erreur a ce niveau, cela me sort juste l'email avec le corps du message sans copier coller les infos du tableau excel.
f894009
Messages postés
17239
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
10 février 2025
1 713
>
solidarinfo
Messages postés
147
Date d'inscription
jeudi 26 mars 2009
Statut
Membre
Dernière intervention
8 décembre 2021
9 juin 2016 à 09:20
9 juin 2016 à 09:20
Bonjour,
Tout a fait normal Thierry.
Un exemple d'envoi d'une selection cellules avec le code de Ron de Bruin que j'ai adapte a mon besoin du moment. J'ai mis les infos To,CC,Sujet, mais a vous de faire le reste pour la selection cellules
https://www.cjoint.com/c/FFjhsNCgoff
Tout a fait normal Thierry.
Un exemple d'envoi d'une selection cellules avec le code de Ron de Bruin que j'ai adapte a mon besoin du moment. J'ai mis les infos To,CC,Sujet, mais a vous de faire le reste pour la selection cellules
https://www.cjoint.com/c/FFjhsNCgoff
solidarinfo
Messages postés
147
Date d'inscription
jeudi 26 mars 2009
Statut
Membre
Dernière intervention
8 décembre 2021
13
9 juin 2016 à 10:25
9 juin 2016 à 10:25
Bonjour,
Merci d'avoir pris le temps. Il y'a une erreur sur la ligne
Merci d'avoir pris le temps. Il y'a une erreur sur la ligne
DIM Outapp As outlook.Applicationdans le début du code : compile error user defined type not defined
f894009
Messages postés
17239
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
10 février 2025
1 713
>
solidarinfo
Messages postés
147
Date d'inscription
jeudi 26 mars 2009
Statut
Membre
Dernière intervention
8 décembre 2021
9 juin 2016 à 10:55
9 juin 2016 à 10:55
Re,
Ok, c'est une histoire de references. Il y a deux facons de faire.
fichier sans utiliser la ref Outlook xx.x library, donc declarations de variable differente
https://www.cjoint.com/c/FFji2hV5SQf
Ok, c'est une histoire de references. Il y a deux facons de faire.
fichier sans utiliser la ref Outlook xx.x library, donc declarations de variable differente
https://www.cjoint.com/c/FFji2hV5SQf
solidarinfo
Messages postés
147
Date d'inscription
jeudi 26 mars 2009
Statut
Membre
Dernière intervention
8 décembre 2021
13
9 juin 2016 à 14:39
9 juin 2016 à 14:39
Ok Super cela fonctionne !
Du coup j'ai modifié le code et tout est nickel sauf une derniere partie : quand j'envoi le mail avec le fichier joint ca me met deux fois l'extension (eporting.xls.xls) du coup le recpteur du mail n peut pas l'ouvrir. Et je ne sais pas comment récupérer le nom du fichier sans l'extension :/
Du coup j'ai modifié le code et tout est nickel sauf une derniere partie : quand j'envoi le mail avec le fichier joint ca me met deux fois l'extension (eporting.xls.xls) du coup le recpteur du mail n peut pas l'ouvrir. Et je ne sais pas comment récupérer le nom du fichier sans l'extension :/
f894009
Messages postés
17239
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
10 février 2025
1 713
9 juin 2016 à 14:58
9 juin 2016 à 14:58
Re,
Nom sans extension, au plus simple
Nom sans extension, au plus simple
Nom_Fichier=Left(Nom_Fichier,len(Nom_Fichier)-4)
solidarinfo
Messages postés
147
Date d'inscription
jeudi 26 mars 2009
Statut
Membre
Dernière intervention
8 décembre 2021
13
9 juin 2016 à 15:02
9 juin 2016 à 15:02
j'ai fait un code qui demande a l'utilisateur d'aller chercher le fichier.
Cette ligne je l'inclus à quel niveau ?
Cette ligne je l'inclus à quel niveau ?
solidarinfo
Messages postés
147
Date d'inscription
jeudi 26 mars 2009
Statut
Membre
Dernière intervention
8 décembre 2021
13
9 juin 2016 à 15:03
9 juin 2016 à 15:03
strFileName = Application.FileDialog(msoFileDialogOpen).SelectedItems(1) 'Je récupère le nom complet du fichier
Workbooks.Open strFileName
J'inclus ta formule aprés cette ligne ?
f894009
Messages postés
17239
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
10 février 2025
1 713
>
solidarinfo
Messages postés
147
Date d'inscription
jeudi 26 mars 2009
Statut
Membre
Dernière intervention
8 décembre 2021
Modifié par f894009 le 9/06/2016 à 15:23
Modifié par f894009 le 9/06/2016 à 15:23
Re,
Oui, mais la c'est le chemin complet, pas de probleme
Oui, mais la c'est le chemin complet, pas de probleme
'Nom de fichier SANS extention en partant du chemin complet Nom_Fichier = Left(Mid(strFileName, InStrRev(strFileName, "\") + 1), Len(Mid(strFileName, InStrRev(strFileName, "\") + 1)) - 4)
solidarinfo
Messages postés
147
Date d'inscription
jeudi 26 mars 2009
Statut
Membre
Dernière intervention
8 décembre 2021
13
Modifié par solidarinfo le 9/06/2016 à 16:21
Modifié par solidarinfo le 9/06/2016 à 16:21
Cela ne marche toujours pas, j'ai du mal
message d'erreur : invalide procedure call or argument
message d'erreur : invalide procedure call or argument
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question
f894009
Messages postés
17239
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
10 février 2025
1 713
10 juin 2016 à 16:11
10 juin 2016 à 16:11
Re,
fichier avec code a recopier dans votre classeur
https://www.cjoint.com/c/FFkolOSMK4f
fichier avec code a recopier dans votre classeur
https://www.cjoint.com/c/FFkolOSMK4f
solidarinfo
Messages postés
147
Date d'inscription
jeudi 26 mars 2009
Statut
Membre
Dernière intervention
8 décembre 2021
13
10 juin 2016 à 19:01
10 juin 2016 à 19:01
Re,
Je vais voir le code et reviens vers toi, merci beaucoup pour ton aide !!!
Je vais voir le code et reviens vers toi, merci beaucoup pour ton aide !!!
solidarinfo
Messages postés
147
Date d'inscription
jeudi 26 mars 2009
Statut
Membre
Dernière intervention
8 décembre 2021
13
16 juin 2016 à 10:10
16 juin 2016 à 10:10
Merci Beaucoup, tu assures f894009!
solidarinfo
Messages postés
147
Date d'inscription
jeudi 26 mars 2009
Statut
Membre
Dernière intervention
8 décembre 2021
13
21 juin 2016 à 10:30
21 juin 2016 à 10:30
Hello f894009,
J'ai un petit soucis sur la macro une nouvelle fois, je peux compter sur ton aide ?
j'ai assemblé ton code et au moment de lancer (aprés avoir raccordé l'ensemble du code) il me lance une erreur en selectionnant END SUB: compile error for without next
pour info j'ai collé le code que tu m'as envoyé à la suite d'un code dont voici l'intégralité
J'ai un petit soucis sur la macro une nouvelle fois, je peux compter sur ton aide ?
j'ai assemblé ton code et au moment de lancer (aprés avoir raccordé l'ensemble du code) il me lance une erreur en selectionnant END SUB: compile error for without next
pour info j'ai collé le code que tu m'as envoyé à la suite d'un code dont voici l'intégralité
Public Sub Test_AMX()
Dim wbSource, wbFichierUsager As Workbook
Dim strFileName As String
Dim intChoice As Integer 'Déclarer les variables de base
Set wbFichierUsager = ThisWorkbook
Application.FileDialog(msoFileDialogOpen).AllowMultiSelect = False 'on indique que nous ne voulons qu’un seul fichier
intChoice = Application.FileDialog(msoFileDialogOpen).Show 'On affiche l’écran de dialogue de MS Office
If intChoice <> 0 Then 'On s’assure que la personne a fait un choix
strFileName = Application.FileDialog(msoFileDialogOpen).SelectedItems(1) 'On récupère le nom complet du fichier
Workbooks.Open strFileName
Else 'Sinon, on arrête tout en notifiant l’usager
MsgBox "La procédure est annulée car aucun fichier n’a été entré. Merci de recommencer et de choisir le fichier AMEX" 'S’il n’y a pas de fichier, on quitte sans rien faire
Exit Sub
End If
' Ouverture fichier Associés
Workbooks.Open Filename:="C:\Users\nelly\Desktop\Listing .xlsx"
Set wbSource = ActiveWorkbook 'definir comme fichier source à fermer apres le copier coller
' Coper les données dans le fichier AMEX
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows( _
"American .xls" _
).Activate
Sheets("Sheet2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.AutoFilter
Range("A1").Select
wbSource.Close SaveChanges:=False 'Application comme fichier source à fermer apres le copier coller
' CopierColler_Infos Macro
Sheets("Rapport Détaillé").Select
Range("H8:M8").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Statistique Factures").Select
Range("I10").Select
ActiveSheet.Paste
Range("O10").Select
Sheets("Rapport Détaillé").Select
Range("Q8:Y8").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Statistique Factures").Select
ActiveSheet.Paste
Range("O10").Select
ActiveSheet.Paste
Range("I11").Select
' Reperage Macro
'
'
Sheets("Rapport Détaillé").Select
Range("G6").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "1"
Range("H6").Select
ActiveCell.FormulaR1C1 = "2"
Range("I6").Select
ActiveCell.FormulaR1C1 = "3"
Range("G6:I6").Select
Selection.AutoFill Destination:=Range("G6:AM6"), Type:=xlFillDefault
Range("G6:AM6").Select
Range("AM6").Select
Range("H6:M6").Select
Selection.Copy
Sheets("Statistique Factures").Select
Range("I9").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("O9").Select
Sheets("Rapport Détaillé").Select
Range("Q6").Select
Range(Selection, Selection.End(xlToRight)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Statistique Factures").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("I11").Select
' Fill_Infos Macro
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(RC2,'Rapport Détaillé'!R8C7:R853C39,'Statistique Factures'!R9C,0)"
Range("I11").Select
Selection.AutoFill Destination:=Range("I11:W11"), Type:=xlFillDefault
Range("I11:W11").Select
'Format date courte invoice date
Range("I11:J11").Select
Selection.NumberFormat = "m/d/yyyy"
'Format date courte travel date
Range("R11:S11").Select
Selection.NumberFormat = "m/d/yyyy"
Range("I11").Select
' Etalage_Formule Macro
'
'
Range("I11").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.AutoFill Destination:=Range("I11:W370")
' Matchingg Macro
' VlookUp Manager
Range("X11").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC3,Sheet2!C9:C11,2,0)"
' VlookUp Email
Range("Y11").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC3,Sheet2!C9:C11,3,0)"
'Extension formule
Range("X11:Y11").Select
Selection.AutoFill Destination:=Range("X11:Y370")
Range("X11:Y370").Select
Range("X10").Select
' Naming Macro
' Renomme cellule manager
Range("X10").Select
ActiveCell.FormulaR1C1 = "Manager"
' Renomme cellule email
Range("Y10").Select
ActiveCell.FormulaR1C1 = "Email"
' Renomme feuille
Sheets("Sheet2").Select
Sheets("Sheet2").Name = "BDD ASSOCIES"
Sheets("Statistique Factures").Select
' Filtering Macro
Range("B10").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Selection.AutoFilter
Columns("A:A").Select
Range(Selection, Selection.End(xlToRight)).Select
Columns("A:X").EntireColumn.AutoFit
Range("C:G").EntireColumn.Hidden = True
' Fine_tunning Macro
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 8367104
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection.Font
.Color = -16711681
.TintAndShade = 0
End With
Selection.Font.Bold = True
Range("A1").Select
Selection.End(xlToRight).Select
Range("X2").Select
Range(Selection, Selection.End(xlDown)).Select
Columns("Q:R").Select
Selection.NumberFormat = "m/d/yyyy"
Columns("H:I").Select
Selection.NumberFormat = "m/d/yyyy"
Range("W1").Select
'-----------------------------------------------------------------------------------------
Dim Liste_Flitre_W, N, Nb
Application.ScreenUpdating = False
'Creation table flitre colonne W
Call Liste_Infos_sans_doublon(Liste_Flitre_W)
Nb = UBound(Liste_Flitre_W)
'si entete colonne commence a 1 sinon a 0
For N = 1 To Nb
' Appliquer filtre
Worksheets("Sheet1").ShowAllData
ActiveSheet.Range("$A$1:$X$361").AutoFilter Field:=23, Criteria1:=Liste_Flitre_W(N)
'----------------------------------------------------------------------------------------------
' Formule subbtotal de la cellule
Range("Y1").Select
ActiveCell.FormulaR1C1 = "=SUBTOTAL(9,C[-22]:C[-18])"
' Mise en format nombre
Selection.NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)"
Selection.NumberFormat = "_-* #,##0.0 $_-;-* #,##0.0 $_-;_-* ""-""?? $_-;_-@_-"
Selection.NumberFormat = "_-* #,##0 $_-;-* #,##0 $_-;_-* ""-""?? $_-;_-@_-"
Selection.Font.Bold = True
' Mise en format couleur
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
'Envoidu_Mail_Outlook()
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
Dim Rng As Range
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim Destwb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim FileExtStr As String
Set Rng = Nothing
On Error Resume Next
Set Rng = Range("A1:W361")
On Error GoTo 0
If Rng Is Nothing Then
MsgBox "The selection is not valid please make sure it is " & _
vbNewLine & "Please correct and try again.", vbOKOnly
Exit Sub
End If
With Application
.EnableEvents = False
'.ScreenUpdating = False
End With
Set Sourcewb = ActiveWorkbook
'Copie de la plage de cellules dans un nouveau classeur
Set Destwb = Workbooks.Add
'copy avec format
Sourcewb.Sheets("sheet1").Range("A1:W361").Copy Destwb.ActiveSheet.Range("A1").Resize(Rng.Rows.Count, Rng.Columns.Count)
'Ajustement colonne
Destwb.ActiveSheet.Cells.EntireColumn.AutoFit
'sauvegarde du nouveau fichier pour joindre dans le mail
TempFilePath = Environ$("temp") & "\" 'repertoire du fichier
TempFileName = "Validation déplacements AMEX " & Format(Now, "dd-mmm-yy h-mm-ss") & Sourcewb.Name 'Nom du fichier avec date
FileExtStr = ".xlsx": FileFormatNum = 51 'extension du fichier en XLS
With Destwb
.SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum 'sauvegarde du fichier sous
.Close SaveChanges:=False
End With
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
'corps du message si besoin
With OutMail
.To = ThisWorkbook.Sheets("Sheet1").Range("Z1").Value 'destinataire(s) A MODIFIER
.CC = "" ' copie
.Subject = "Validation déplacement de ton équipe" ' Sujet
.HTMLBody = "Bonjour ," & _
vbNewLine & "Tu trouveras ci-dessous les qui s'élévent à" & " " & Range("Y1") & "€" & ". Voici le détail :" & RangetoHTML(Rng)
.Attachments.Add TempFilePath & TempFileName & FileExtStr
.Display 'OU send pour envoyer
End With
On Error GoTo 0
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
Function RangetoHTML(Rng As Range)
' Changed by Ron de Bruin 28-Oct-2006 SUITE DE LA MACRO PUIS RETOUR A ATTACEMENTS
' Modified by f894009
Dim fso As Object
Dim ts As Object
Dim TempFile As String
Dim TempWB As Workbook
TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
'Copy the range and create a new workbook to past the data in
Rng.Copy
Set TempWB = Workbooks.Add(1)
With TempWB.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial xlPasteValues, , False, False
.Cells(1).PasteSpecial xlPasteFormats, , False, False
.Cells(1).Select
Application.CutCopyMode = False
On Error Resume Next
.DrawingObjects.Visible = True
.DrawingObjects.Delete
On Error GoTo 0
End With
'Publish the sheet to a htm file
With TempWB.PublishObjects.Add( _
SourceType:=xlSourceRange, _
Filename:=TempFile, _
Sheet:=TempWB.Sheets(1).Name, _
Source:=TempWB.Sheets(1).UsedRange.Address, _
HtmlType:=xlHtmlStatic)
.Publish (True)
End With
'Read all data from the htm file into RangetoHTML
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
RangetoHTML = ts.readall
ts.Close
RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
"align=left x:publishsource=")
'Close TempWB
TempWB.Close SaveChanges:=False
'Delete the htm file we used in this function
Kill TempFile
Set ts = Nothing
Set fso = Nothing
Set TempWB = Nothing
End Function
'
Sub Liste_Infos_sans_doublon(TMP)
Dim Dico_Data As Object, Plage, x
With Worksheets("sheet1")
Set Dico_Data = CreateObject("Scripting.Dictionary")
derlig = .Range("W" & Rows.Count).End(xlUp).Row 'derniere cellule non vide colonne A
Plage = .Range("W1:W" & derlig) 'mise en memoire
'boucle sur plage
For x = 1 To UBound(Plage, 1)
Dico_Data(Plage(x, 1)) = ""
Next x
End With
'transfert infos en tableau
TMP = Dico_Data.Keys 'Table sans doublon
End Sub