Discussion :

[willyava]

Bonjour,

J'aimerai savoir comment il serait possible d'importer à la suite une soixantaine de fichier (avec un format inconnu pour excel) ?
Toutes les colonnes sont séparés par des points virgules.
Sauf que tous les mois les fichiers changent de noms (leur nom est une date) mais pas de dossier.

Ensuite je fais mon petit macro que j'ai déjà réussi à faire.

Mais il me reste une question.
J'aimerai ajouter à la suite de chaque ligne le nom de l'entreprise qui correspond au numéro de téléphone de la colonne B automatiquement. Comment puis-je m'y prendre ?

Merci pour votre aide

Si besoin demandez moi des renseignements complémentaires !

[PPz78]

Pour ouvrir successivement plusieurs fichiers : voir l'instruction DIR et les nombreux fils de discussion qui parlent de ce sujet.

Pour le Pb de format inconnu, tu mets Excel dans l'état enregistrement de macro et tu ouvres un fichier à la main. Ensuite tu regarde le résultat et adapte la macro en conséquence.

PPz

Merci de cocher Résolu pour ce fil de discussion.

PPz

[willyava]

Merci de ton aide, je vais me renseigner la dessus, mais est-ce qu'il possible avec ce DIR de réutiliser cette macro avec des fichiers qui n'ont pas le même nom, mais qui sont dans le même répertoire sans que les anciens y soient restés ? (j'espère que je suis assez clair :p )


Et pour mon deuxième problème, as tu une idée ?

J'aimerai ajouter à la suite de chaque ligne le nom de l'entreprise qui correspond au numéro de téléphone de la colonne B automatiquement.

Je pensai que peut-être en faisant un genre de base de donnée dans un autre classeur il serait possible de faire vérifier dans le premier classeur les numéros de téléphone par rapport aux noms dans le deuxième classeur pour ensuite les associer dans le premier.

Est-ce possible, si oui comment ?

Encore merci

EDIT :

En enregistrant une macro et faisant ce dont j'avais besoin juste pour un fichier cela m'a affiché ça :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub Macro2()
'
' Macro2 Macro
'
 
'
    ChDir "D:\Documents\logs"
    Workbooks.OpenText Filename:="D:\Documents\logs\RecupCDRJuilletAout.ok", _
        Origin:=xlMSDOS, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
        xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=True, _
        Comma:=False, 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)), _
        TrailingMinusNumbers:=True
End Sub

Ce que j'aimerai c'est qu'excel aille chercher lui même tous les fichiers et qu'il me les copie les uns à la suite des autres, tout en lui disant que le signe de séparation est un point virgule

[PPz78]

C'est justement la fonction DIR qui va te donner les noms des fichiers contenus dans le répertoire.
Il suffira de mettre le nom du fichier en lieu et place de

Code :

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

"D:\Documents\logs\RecupCDRJuilletAout.ok"

Dans les exemple de DIR tu trouveras

Code :

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

1
2
3
4
5
6
7
' Renvoie le nom de fichier avec l'extension indiquée. Si plusieurs
' fichiers *.ini existent, le premier fichier trouvé est renvoyé.
MyFile = Dir("C:\WINDOWS\*.INI")
 
' Appelle de nouveau Dir sans argument pour renvoyer le
' fichier *.INI suivant dans le même dossier.
MyFile = Dir

[willyava]

En cherchant avec le mot clef DIR sur le forum j'ai trouvé un post qui m'a intéressé.

Nako Lito a envoyé ce code :

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
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
Sub general()
    Application.ScreenUpdating = False
 
    'remplit les en-tete
    With ThisWorkbook.Sheets(1)
    .Cells(1, 1) = "Nom"
    .Cells(1, 2) = "Prénom"
    .Cells(1, 3) = "Adresse"
    .Cells(1, 4) = "Numéro"
    .Cells(1, 5) = "Code Postal"
    .Cells(1, 6) = "Ville"
    .Cells(1, 8) = "Téléphone fixe"
    .Cells(1, 7) = "Date de naissance"
    .Cells(1, 9) = "Téléphone portable"
    .Cells(1, 10) = "Adresse mail"
    .Cells(1, 11) = "Carte LAC"
    .Cells(1, 12) = "Date d'effet"
    End With
 
    'declaration de variable
    Dim objFSO As Object
    Dim objDossier As Object
    Dim objFichier As Object
 
    'initialisation des variables
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    'definit le repertoire ou se trouvent les feuilles a traiter
    Set objDossier = objFSO.GetFolder("C:\Documents and Settings\Labar\Bureau\Nouveau dossier")
 
    'pour chaque classeur dans le répertoire
    For Each objFichier In objDossier.Files
        'ouvre le classeur
        Workbooks.Open objFichier
 
        'lance la méthode copierColler pour toute les cellules a copier
        'nom
        copierColler "C4", 1
        'prenom
        copierColler "F4", 2
        'adresse
        copierColler "C5", 3
        'numero de rue
        copierColler "G5", 4
        'code postal
        copierColler "C6", 5
        'ville
        copierColler "E6", 6
        'date de naissance
        copierColler "C7", 7
        'tel fixe
        copierColler "F7", 8
        'telephone portable
        copierColler "C8", 9
        'adresse mail
        copierColler "E8", 10
        'Carte LAC
        copierColler "C9", 11
        'Date effet
        copierColler "E9", 12
 
        'ferme le classeur client sans sauvegarder
        Workbooks(Workbooks.Count).Close saveChanges:=False
 
    Next
 
    'tout ca, c'est pour la mise en forme
    '---------------------------------------------------
    With ThisWorkbook.Sheets(1)
 
        With .Cells
            With .Font
                .Name = "Arial"
                .Bold = False
                .Italic = False
                .ColorIndex = 0
                .Size = 10
            End With
 
            .HorizontalAlignment = xlLeft
            .Borders(xlDiagonalDown).LineStyle = xlNone
            .Borders(xlDiagonalUp).LineStyle = xlNone
            .Borders(xlEdgeLeft).LineStyle = xlNone
            .Borders(xlEdgeTop).LineStyle = xlNone
            .Borders(xlEdgeBottom).LineStyle = xlNone
            .Borders(xlEdgeRight).LineStyle = xlNone
            .Borders(xlInsideVertical).LineStyle = xlNone
            .Borders(xlInsideHorizontal).LineStyle = xlNone
 
        End With
    '---------------------------------------------------
 
        'copie la feuille vers un nouveau classeur
        .Copy
 
 
    End With
 
    'efface les cellules dans thisworkbook
    ThisWorkbook.Sheets(1).Cells.Clear
 
    'renome la feuille qui vient d'etre copiée
    Workbooks(Workbooks.Count).Sheets(1).Name = "COMMERCIAL"
 
    'enregistre le nouveau classeur dans le repertoire de destination
    Workbooks(Workbooks.Count).SaveAs "B:\FICHIER_COMMERCIAL.xls"
 
    'ferme le nouveau classeur
    Workbooks(Workbooks.Count).Close
 
    Application.ScreenUpdating = True
 
End Sub
 
'méthode qui copie une donnée depuis le classeur client vers thisworkbook
Public Sub copierColler(rangeSource As String, colonneDestination As Integer)
    With ThisWorkbook
        'si la cellule est vide
        If Workbooks(Workbooks.Count).Sheets(2).Range(rangeSource) = "" Then
            'on la remplit avec qqc
            Workbooks(Workbooks.Count).Sheets(2).Range(rangeSource) = "_"
        End If
        'copie la cellule depuis le classeur client
        Workbooks(Workbooks.Count).Sheets(2).Range(rangeSource).Copy
        'colle dans la colonne qui va bien dans thisworkbook
        .Sheets(1).Cells(lastRow(.Name, .Sheets(1).Name, colonneDestination) + 1, colonneDestination).PasteSpecial
    End With
End Sub
 
'methode qui permet de connaitre la derniere ligne d'une colonne
Public Function lastRow(leClasseur As String, laFeuille As String, laColonne As Integer)
    lastRow = Workbooks(leClasseur).Sheets(laFeuille).Cells(65536, laColonne).End(xlUp).Row
End Function

D'apparence il ressemble beaucoup à ce dont j'ai besoin, donc je me suis permis de le modifier pour qu'il réponde au mieux à mes besoins. J'ai essentiellement viré des morceaux de mise en page qui n'avaient pas d'intérêt pour moi.

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
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
Sub general()
    Application.ScreenUpdating = False
 
 
    'declaration de variable
    Dim objFSO As Object
    Dim objDossier As Object
    Dim objFichier As Object
 
    'initialisation des variables
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    'definit le repertoire ou se trouvent les feuilles a traiter
    Set objDossier = objFSO.GetFolder("D:\blabla\RecupCDR")
 
    'pour chaque classeur dans le répertoire
    For Each objFichier In objDossier.Files
        'ouvre le classeur
        Workbooks.Open objFichier
 
        'lance la méthode copierColler pour toute les cellules a copier
        'nom
        copierColler "C4", 1
        'prenom
        copierColler "F4", 2
        'adresse
        copierColler "C5", 3
        'numero de rue
        copierColler "G5", 4
        'code postal
        copierColler "C6", 5
        'ville
        copierColler "E6", 6
        'date de naissance
        copierColler "C7", 7
        'tel fixe
        copierColler "F7", 8
        'telephone portable
        copierColler "C8", 9
        'adresse mail
        copierColler "E8", 10
        'Carte LAC
        copierColler "C9", 11
        'Date effet
        copierColler "E9", 12
 
        'ferme le classeur client sans sauvegarder
        Workbooks(Workbooks.Count).Close saveChanges:=False
 
    Next
 
 
    With ThisWorkbook.Sheets(1)
 
        'copie la feuille vers un nouveau classeur
        .Copy
 
    End With
 
    'efface les cellules dans thisworkbook
    ThisWorkbook.Sheets(1).Cells.Clear
 
    'renome la feuille qui vient d'etre copiée
    Workbooks(Workbooks.Count).Sheets(1).Name = "RecupCDR"
 
    'enregistre le nouveau classeur dans le repertoire de destination
    Workbooks(Workbooks.Count).SaveAs "D:\FICHIER_RecupCDR.xls"
 
    'ferme le nouveau classeur
    Workbooks(Workbooks.Count).Close
 
    Application.ScreenUpdating = True
 
End Sub
 
'méthode qui copie une donnée depuis le classeur client vers thisworkbook
Public Sub copierColler(rangeSource As String, colonneDestination As Integer)
    With ThisWorkbook
        'si la cellule est vide
        If Workbooks(Workbooks.Count).Sheets(2).Range(rangeSource) = "" Then
            'on la remplit avec qqc
            Workbooks(Workbooks.Count).Sheets(2).Range(rangeSource) = "_"
        End If
        'copie la cellule depuis le classeur client
        Workbooks(Workbooks.Count).Sheets(2).Range(rangeSource).Copy
        'colle dans la colonne qui va bien dans thisworkbook
        .Sheets(1).Cells(lastRow(.Name, .Sheets(1).Name, colonneDestination) + 1, colonneDestination).PasteSpecial
    End With
End Sub
 
'methode qui permet de connaitre la derniere ligne d'une colonne
Public Function lastRow(leClasseur As String, laFeuille As String, laColonne As Integer)
    lastRow = Workbooks(leClasseur).Sheets(laFeuille).Cells(65536, laColonne).End(xlUp).Row
End Function

Comme je n'ai pas d'expérience dans ce domaine je ne sais pas si le code est encore utilisable ainsi.

J'aimerai maintenant modifier la partie que l'on applique à tous les fichiers du dossier.
Au lieu d'ouvrir simplement un fichier .xls, ici c'est un fichier .ok non reconnu par excel qu'il faut ouvrir. Donc je dois implémenter à ce code (quelque part je ne sais où) quelque chose comme ça :

Code :

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

1
2
3
4
5
Origin:=xlMSDOS, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
        xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=True, _
        Comma:=False, 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)), _
        TrailingMinusNumbers:=True

pour que excel ouvre le fichier en délimitant les colonnes grâce aux point-virgules présents.

Ensuite il faut non pas que je copie une seule cellule (XY) mais toute la colonne X, et que je la colle sur la colonne X' du nouveau fichier.

J'ai vraiment besoin d'aide svp, j'ai beau me documenter mais j'ai vraiment du mal à comprendre !

Merci d'avance

[willyava]

Pour le deuxième problème, celui de mettre les noms en fonction des numéros de téléphone, il est presque réglé.

Reste que le premier si quelqu'un peut m'aider

Je vous remercie d'avance !

[willyava]

Celui indiqué juste au dessus :p
Merci !