XL 2010 une macro qui existerait pour tous les nouveaux classeurs

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

superbog

XLDnaute Occasionnel
Bonjour,

j'ai une macro (cf ci dessous) que je voudrais rendre automatiquement disponible pour tous les classeurs excels s'ouvrant sur une certaine machine.
En fait voici la situation:
la secrétaire de l'association doit prendre des fichiers csv (en fait des imports des contacts gmail) et les transformer en une liste d'email (cf https://www.excel-downloads.com/thr...-contenant-sur-une-nouvelle-feuille.20014617/)
J'ai donc (avec l'aide du forum 🙂 créé une macro qui fonctionne bien (quoiqu'un peu lente, si vous avez une idée d'accélération...). Je voudrais que cette macro soit disponible chaque fois qu'elle ouvrira excel ainsi elle pourra l'appliquer à ses nouveaux csv.
merci d'avance

VB:
Dim plage As Range
Dim cel As Variant


Columns("A:A").Select
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
        Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
        Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1 _
        ), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array _
        (20, 1), Array(21, 1), Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 1), Array(26, 1), _
        Array(27, 1), Array(28, 1), Array(29, 1), Array(30, 1), Array(31, 1), Array(32, 1), Array( _
        33, 1), Array(34, 1), Array(35, 1), Array(36, 1), Array(37, 1), Array(38, 1), Array(39, 1), _
        Array(40, 1), Array(41, 1), Array(42, 1), Array(43, 1), Array(44, 1), Array(45, 1), Array( _
        46, 1), Array(47, 1), Array(48, 1), Array(49, 1), Array(50, 1), Array(51, 1), Array(52, 1), _
        Array(53, 1), Array(54, 1), Array(55, 1), Array(56, 1), Array(57, 1), Array(58, 1), Array( _
        59, 1), Array(60, 1), Array(61, 1), Array(62, 1), Array(63, 1), Array(64, 1), Array(65, 1), _
        Array(66, 1), Array(67, 1), Array(68, 1), Array(69, 1), Array(70, 1), Array(71, 1), Array( _
        72, 1), Array(73, 1), Array(74, 1), Array(75, 1), Array(76, 1), Array(77, 1), Array(78, 1), _
        Array(79, 1), Array(80, 1), Array(81, 1), Array(82, 1), Array(83, 1), Array(84, 1), Array( _
        85, 1), Array(86, 1), Array(87, 1), Array(88, 1)), TrailingMinusNumbers:=True
    Cells.Select

ActiveSheet.Name = "google"

Sheets.Add.Name = "email"

With Sheets("google")
Set plage = .Range("a2:CZ900" & .Range("a" & Rows.Count).End(xlUp).Row)
For Each cel In plage
If cel Like "*@*" Then
cel.Copy Sheets("email").Range("A2000").End(xlUp)(2)
End If
Next cel
End With
 
Sheets("email").Range("$A$2:$A$2000").RemoveDuplicates Columns:=Array(1), Header:=xlNo
 
MsgBox "fini"

End Sub
 
Bonsoir
Je pense que je lirais le .csv avec une macro plutôt que de l'ouvrir avec Excel.
En attendant voici un bout de code pour faire avancer le schmilblick :
VB:
Sub test()
Dim ZDon As String, TSpl() As String, N As Long, TRés(1 To 100, 1 To 1), L As Long
ZDon = "aaaa,bbdd,cc@dd,eeee,ff@gg,hhhh"
TSpl = Split(ZDon, ",")
For N = 0 To UBound(TSpl)
   If TSpl(N) Like "*@*" Then
      L = L + 1
      TRés(L, 1) = TSpl(N)
      End If: Next N
ActiveSheet.[A2:A101].Value = TRés
End Sub
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
5
Affichages
379
Réponses
1
Affichages
376
Réponses
3
Affichages
569
Réponses
2
Affichages
1 K
Réponses
22
Affichages
3 K
Réponses
7
Affichages
2 K
Retour