Discussion :

[atk_49]

Bonjour à tous,

Afin de remplir un programme d'emailing, je dois effectuer des opérations de tri, de répartitions et de conversions afin d'obtenir uniquement les données qui m’intéressent dans des fichiers texte portant le nom des groupes des contacts.
Le fichier de base est au format CSV provenant d'un client mail. (thunderbird)
Afin de simplifier cela j'ai mis en place un code que j'ai développé sur un bouton, voici le code en question :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
Private Sub CommandButton1_Click()
Columns("A:A").Select
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, Comma:=True, FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True
	Range("A:D,F:F,G:G,I:AK").Select
    Selection.Delete Shift:=xlToLeft
    Rows("1:1").Select
    Selection.Delete Shift:=xlUp
Columns("B:B").Select
    Selection.TextToColumns Destination:=Range("B1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, Other:=True, OtherChar _
        :="-", FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True
	Range("C:D").Select
    Selection.Delete Shift:=xlToLeft
 
    Dim lgLig As Long, lgLigFin As Long, lgLigDerAgent As Long
    Dim boRecherche As Boolean
    Dim strAgent As String
    Application.ScreenUpdating = False    
    lgLigFin = Worksheets("contact").Range("B" & Cells.Rows.Count).End(xlUp).Row
    For lgLig = 1 To lgLigFin
        strAgent = Worksheets("contact").Range("B" & lgLig).Value
        boRecherche = RechercherWS(strAgent)
        If boRecherche = False Then
            Worksheets.Add after:=Worksheets(ThisWorkbook.Worksheets.Count)
            ActiveSheet.Name = strAgent
        End If
        lgLigDerAgent = Worksheets(strAgent).Range("B" & Cells.Rows.Count).End(xlUp).Row + 1
        Worksheets("contact").Range("A" & lgLig & ":B" & lgLig).Copy Destination:=Worksheets(strAgent).Range("A" & lgLigDerAgent)
    Next lgLig
    Sheets.Select
	Columns("B:B").Select
    Selection.Delete Shift:=xlToLeft
    Rows("1:1").Select
    Selection.Delete Shift:=xlUp
	For Each Feuille In ThisWorkbook.Worksheets
        Feuille.Copy
		ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & ActiveWorkbook.Worksheets(1).Name_
        , FileFormat:=xlTextMSDOS, CreateBackup:=False
		ActiveWorkbook.Close savechanges:=False
    Next Feuille
	Application.ScreenUpdating = True
    MsgBox "La répartition s'est terminée avec succès !"
End Sub
 
Private Function RechercherWS(strAgent As String) As Boolean
    Dim wsFeuil As Worksheet
    RechercherWS = False
    For Each wsFeuil In ThisWorkbook.Worksheets
        If wsFeuil.Name = strAgent Then
            RechercherWS = True
            Exit For
        End If
    Next wsFeuil
End Function

J'obtiens le résultat souhaité malgré mes compétences limitées en VBA. (il y a surement plus simple, soyez tolérant )

Mon problème est le suivant : Je souhaiterais éviter la création systématique d'un bouton dans le fichier CSV car mes collègues doivent également faire cette procédure. Pour cela j'ai pensé utiliser le fichier PERSONNAL.XLSB.
La fleur au fusil j'ai donc intégré ce code dans une macro (Sub etc...) mais ça ne fonctionne pas, VBA bloque à la ligne 26 en m'indiquant qu'il ne peut pas créer de fichier. J'ai bien l'impression que la macro ne prends pas en compte la fonction RechercherWS, qu'en pensez-vous ?

Merci d'avance à tous !

[Philippe Tulliez]

Bonjour,

VBA bloque à la ligne 26 en m'indiquant qu'il ne peut pas créer de fichier.

C'est curieux parce-que ligne 26, je vois cette ligne

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

ActiveSheet.Name = strAgent

or ActiveSheet est une feuille et pas un fichier. Soit ton message d'erreur est différent soit ce n'est pas à la ligne 26 que l'erreur se produit.
Questions :
Quelle est la valeur de la variable strAgent ?
Est-ce le nom (valeur de strAgent) n'est pas déjà attribué à une autre feuille du même classeur.

[parmi]

Bonjour,

Si tu as mis la macro dans Personal.xlsb, il faudra faire la différence entre ActiveWorkbook et ThisWorkbook.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Worksheets.Add after:=Worksheets(ThisWorkbook.Worksheets.Count)

Dans ce cas-ci, ThisWorkbook devient Personal.xlsb et ce n'est sûrement pas ce que tu veux...