XL 2010 une macro qui existerait pour tous les nouveaux classeurs

[superbog]

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

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

 

[Lone-wolf]

Re

Pourquoi avoir ouvert 2 posts??? 🙄

 

[chris]

Bonjour

Utiliser soit le classeur de macro personnelles soit un fichier xlam (add on)

 

[Dranreb]

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 :

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