Macro lecture de données puis ventilation selon colonne dans 2 fichiers de sortie

**Messager.J** · 16/08/2015, 13h33

Bonjour,

Je vous explique le travail que je veux faire :

A partir d'un fichier source, je veux créer 2 fichiers de sortie, un qui contiendra les données de juillet et l'autre pour Aout. J'aimerais que mon programme me demande via l'explorateur de fichier quel fichier est le fichier source, puis le programme se charge de la répartition des données entre les 2 classeurs de sortie qu'il génère.

Ce que j'ai réussi à faire : copier/coller les bonnes infos dans chaque classeur, cependant, les données ne sont pas les unes à la suite des autres ... J'ai essayé d'intégrer un compteur qui me donne la dernière ligne du classeur avant de copier les données mais j'ai un bug avec le message d'erreur : "Erreur d'exécution 13 : Incompatibilité de type. Je ne vois pas le problème.

Voici le 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
Sub MacroBIS()
    '
    '   Programme
    '---------------------------------------------------------------------
    '
    Dim FichierSource As String
    FichierSource = "C:\Users\JM\Downloads\SI_158676.csv"             'Adresse du fichier source
    '
    '   Pour créer les 2 fichiers de sorties : Juillet et Aout
    '       je ne sais pas comment enregistrer le fichier sous "tel nom"
    '
    Workbooks.Add
    'ActiveWorkbook.Save
    'ActiveWindow.Close
    '
    '   Ouverture du fichier source 
    Workbooks.Open Filename:=FichierSource
    '
    '   Données / convertir / ,  / en sélectionnant la colonne A (la 1ère)
    '
    Columns("A:A").Select
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        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)), _
        TrailingMinusNumbers:=True
    '
    '   Boucle sur la colonne date afin de déterminer si la ligne dois aller dans le fichier de Juillet ou Aout
    '
    Dim i As Integer
    'i = 2
 
    For i = 2 To 12
    '
    If Range("C" & i).Value = "20150722" Then
        '
        Windows("SI_158676.csv").Activate
        Rows(i & ":" & i).Select
        Selection.Copy
        Windows("TestJuillet.csv").Activate
        '
        '   Compteur pour avoir la dernière ligne du classeur et ensuite copier/coller les infos à la suite
        '
        Dim DerniereLigne1 As Long
        DerniereLigne1 = Range("B65536").End(xlUp).Rows
            If DerniereLigne1 = 0 Then
                DerniereLigne1 = 2
            Else
                DerniereLigne1 = DerniereLigne1 + 1
            End If
        MsgBox (DerniereLigne1)
        '
        Range("A" & DerniereLigne1).Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        '
    ElseIf Range("C" & i).Value = "20150801" Then
        '
        Windows("SI_158676.csv").Activate
        Rows(i & ":" & i).Select
        Selection.Copy
        Windows("TestAout.csv").Activate
        '
        '   Compteur pour avoir la dernière ligne du classeur et ensuite copier/coller les infos à la suite
        '
        Dim DerniereLigne2 As Long
        DerniereLigne2 = Range("B65536").End(xlUp).Rows
            If DerniereLigne2 = 0 Then
                DerniereLigne2 = 2
            Else
                DerniereLigne2 = DerniereLigne2 + 1
            End If
        MsgBox (DerniereLigne2)
        '
        Range("A" & DerniereLigne2).Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        '
    End If
    '
    Windows("SI_158676.csv").Activate
    '
    Next i
    '
End Sub

Est ce que quelqu'un aurait une idée, une piste pour m'aider ?

Je n'arrive pas à fournir le fichier en pièce jointe, les fichiers csv sont acceptés ?? A défaut il est en xlsx.

Merci d'avance !!

**electrons** · 17/08/2015, 13h57

Bonjour,
Il serait bon d'exécuter le programme VBA en "pas à pas détaillé" avec la touche "F8".
Il suffit de positionner le curseur devant une ligne de code (la première par exemple) et d'appuyer sur "Ctrl+F8" puis régulièrement sur "F8". cela permet de voir le contenu des variables.

Bon travail

**Messager.J** · 17/08/2015, 15h23

Bonjour,

J'ai bien essayé cette technique cependant je n'arrive pas à trouver la solution.

**Igloobel** · 17/08/2015, 16h22

Bonjour,

deux-trois petites choses

1°) il est préférable d'utiliser les balises Codes (#) pour visionner le code et de plus indente le pour une lecture plus aisée, comme suit.

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
Sub MacroBIS()
'
' Programme
'---------------------------------------------------------------------
'
Dim FichierSource As String
FichierSource = "C:\Users\JM\Downloads\SI_158676.csv" 'Adresse du fichier source
'
' Pour créer les 2 fichiers de sorties : Juillet et Aout
' je ne sais pas comment enregistrer le fichier sous "tel nom"
'
Workbooks.Add
'ActiveWorkbook.Save
'ActiveWindow.Close
'
' Ouverture du fichier source 
Workbooks.Open Filename:=FichierSource
'
' Données / convertir / , / en sélectionnant la colonne A (la 1ère)
'
Columns("A:A").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
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)), _
TrailingMinusNumbers:=True
'
' Boucle sur la colonne date afin de déterminer si la ligne dois aller dans le fichier de Juillet ou Aout
'
Dim i As Integer
'i = 2
 
For i = 2 To 12
	'
	If Range("C" & i).Value = "20150722" Then
	'
		Windows("SI_158676.csv").Activate
		Rows(i & ":" & i).Select
		Selection.Copy
		Windows("TestJuillet.csv").Activate
 
	'
	' Compteur pour avoir la dernière ligne du classeur et ensuite copier/coller les infos à la suite
	'
		Dim DerniereLigne1 As Long
		DerniereLigne1 = Range("B65536").End(xlUp).Rows
		If DerniereLigne1 = 0 Then
			DerniereLigne1 = 2
		Else
			DerniereLigne1 = DerniereLigne1 + 1
		End If
		MsgBox (DerniereLigne1)
	'
		Range("A" & DerniereLigne1).Select
		Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
	'
	ElseIf Range("C" & i).Value = "20150801" Then
	'
		Windows("SI_158676.csv").Activate
		Rows(i & ":" & i).Select
		Selection.Copy
		Windows("TestAout.csv").Activate
		'
		' Compteur pour avoir la dernière ligne du classeur et ensuite copier/coller les infos à la suite
		'
		Dim DerniereLigne2 As Long
		DerniereLigne2 = Range("B65536").End(xlUp).Rows
		If DerniereLigne2 = 0 Then
			DerniereLigne2 = 2
		Else
			DerniereLigne2 = DerniereLigne2 + 1
		End If
		MsgBox (DerniereLigne2)
		'
		Range("A" & DerniereLigne2).Select
		Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
		'
	End If
	'
	Windows("SI_158676.csv").Activate
'
Next i
'
End Sub

2°) je te conseille d'ouvrir directement le fichier en faisant comme suit:

Code :

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

1
2
3
4
5
6
7
8
Sub Ouv_Fic_Csv()
    Workbooks.OpenText Filename:= _
        "D:\essais\Messager J\SI_158676.CSV", Origin:=xlMSDOS, _
        StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
        ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, Comma:=True _
        , Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1), _
        Array(3, 5), Array(4, 1), Array(5, 1)), TrailingMinusNumbers:=True
End Sub

3°) pour atteindre la dernière ligne je préfère utilisé ces instructions qui sont plus pratique à mon sens

Code :

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

1
2
3
4
5
6
7
8
Sub Calc_dern_Lig_Col()
   Dim Nomf As String
   Nomf = "Feuil1"
 
   MsgBox "Ligne : " & ThisWorkbook.Worksheets(Nomf).UsedRange.Rows.Count & vbCrLf & _
   "Colonne : " & ThisWorkbook.Worksheets(Nomf).UsedRange.Columns.Count
 
End Sub

3°) pour savoir si tu met dans Juillet ou Aout il suffit de verifier dans ta colonne C si en position 5-6 tu as 07 ou 08 (utilisation de l'instruction "Mid")

en fin plutôt que d'utiliser l'objet Range pour tester la valeur d'une cellule utilise l'objet Cell(N°ligne,N°colonne) c'est plus facile

A bientôt

**Messager.J** · 17/08/2015, 21h11

En prenant certaines de tes remarques, voici mon code qui marche.

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
Option Explicit
 
Private Sub UserForm_Initialize()
    '
    '   Code au lancement du UserForm
    '
    Label1.Caption = "Nom du fichier"
    Btn1.Caption = "Lancer la macro"
    '
End Sub
 
Private Sub Btn1_Click()
    '
    '   Macro pour la séparation du fichier
    '-------------------------------------------------------------------------------
    '
    '   Ouverture du fichier source
    '
    Dim NomFichier As String
    NomFichier = TextBox1.Text
    '
    Workbooks.OpenText Filename:= _
        "C:\Users\JM\Downloads\" & NomFichier & ".csv", Origin:=xlMSDOS, _
        StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
        ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, Comma:=True _
        , Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1), _
        Array(3, 5), Array(4, 1), Array(5, 1)), TrailingMinusNumbers:=True
    '
    Windows(NomFichier & ".csv").Visible = False
    '
    '   Création des 2 fichiers de sortie
    '
    Workbooks.Add
    ActiveWorkbook.SaveAs Filename:="C:\Users\JM\Downloads\" & NomFichier & "_Juillet.csv"
    '
    Windows(NomFichier & "_Juillet.csv").Visible = False
    '
    Windows(NomFichier & ".csv").Activate
    Rows("1:1").Select
    Selection.Copy
    Windows(NomFichier & "_Juillet.csv").Activate
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    '
    Workbooks.Add
    ActiveWorkbook.SaveAs Filename:="C:\Users\JM\Downloads\" & NomFichier & "_Aout.csv"
    '
    Windows(NomFichier & "_Aout.csv").Visible = False
    '
    Windows(NomFichier & ".csv").Activate
    Rows("1:1").Select
    Selection.Copy
    Windows(NomFichier & "_Aout.csv").Activate
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    '
    '
    '   Boucle sur la colonne date afin de déterminer si la ligne dois aller dans le fichier de Juillet ou Aout
    '
    Windows(NomFichier & ".csv").Activate
    '
    Dim i As Integer
    'i = 2
 
    For i = 2 To 12
    '
    '
    If Range("C" & i).Value = "20150722" Then
        '
        Rows(i & ":" & i).Select
        Selection.Copy
        Windows(NomFichier & "_Juillet.csv").Activate
        '
        '   Compteur pour avoir la dernière ligne du classeur et ensuite copier/coller les infos à la suite
        '
        Dim DerniereLigne1 As Long
        DerniereLigne1 = Workbooks(NomFichier & "_Juillet.csv").Worksheets(1).UsedRange.Rows.Count + 1
        '
        Range("A" & DerniereLigne1).Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        '
    ElseIf Range("C" & i).Value = "20150801" Then
        '
        Rows(i & ":" & i).Select
        Selection.Copy
        Windows(NomFichier & "_Aout.csv").Activate
        '
        '   Compteur pour avoir la dernière ligne du classeur et ensuite copier/coller les infos à la suite
        '
        Dim DerniereLigne2 As Long
        DerniereLigne2 = Workbooks(NomFichier & "_Aout.csv").Worksheets(1).UsedRange.Rows.Count + 1
        '
        Range("A" & DerniereLigne2).Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        '
    End If
    '
    Windows(NomFichier & ".csv").Activate
    '
    Next i
    '
    End
    '
    Workbooks(NomFichier & ".csv").Close SaveChanges:=False
    Workbooks(NomFichier & "_Juillet.csv").Close SaveChanges:=True
    Workbooks(NomFichier & "_Aout.csv").Close SaveChanges:=True
    '
End Sub

Cependant j'aimerais améliorer 2 points :
- est-il possible de cacher les feuilles excel lors du traitement de la macro ?

J'ai bien essayé avec :

Code :

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

Windows(NomFichier & ".csv").Visible = False

Mais j'ai pas l'impression que cela marche, ou alors je ne dois pas le placer au bon endroit !

Mon code à la fin pour enregistrer et fermer les classeurs n'a pas l'air de fonctionner puisque les classeurs restent ouverts ...

Code :

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

1
2
3
Workbooks(NomFichier & ".csv").Close SaveChanges:=False
    Workbooks(NomFichier & "_Juillet.csv").Close SaveChanges:=True
    Workbooks(NomFichier & "_Aout.csv").Close SaveChanges:=True

Merci d'avance pour votre aide !!!

**Igloobel** · 18/08/2015, 09h51

Envoyé par Messager.J

Cependant j'aimerais améliorer 2 points :
- est-il possible de cacher les feuilles excel lors du traitement de la macro ?

J'ai bien essayé avec :

Code :

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

Windows(NomFichier & ".csv").Visible = False

Mais j'ai pas l'impression que cela marche, ou alors je ne dois pas le placer au bon endroit !

Merci d'avance pour votre aide !!!

A mon avis

Code :

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

Application.Visible = False

devrait faire l'affaire

tu dis

A+

**Messager.J** · 19/08/2015, 20h23

J'ai bien essayé votre solution, à savoir :

Code :

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

Application.Visible = False

Le classeur est bien caché, cependant lors de l'exécution de la macro, les autres classeurs créés apparaissent ...

**Igloobel** · 20/08/2015, 09h43

Bonjour,

je pense que cela vient de tes Select inutile.

Ton code:

Code :

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

1
2
3
4
5
6
...
Windows("SI_158676.csv").Activate
Rows(i & ":" & i).Select
Selection.Copy
Windows("TestAout.csv").Activate 
...

que tu peux transformé en

Code :

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

1
2
3
4
5
...
Windows("SI_158676.csv").Activate
Rows(i & ":" & i).Copy
Windows("TestAout.csv").Activate
...

Une question pourquoi tes sorties sont en CSV et pas en format Excel ?

**Messager.J** · 20/08/2015, 19h00

J'ai en effet modifier mon code à la suite de ton commentaire, le code fonctionne toujours, merci de l'info !

Cependant, cela ne change pas mon problème : les classeurs créés sont visibles et ne s'enregistrent pas ... Alors que le classeur qui contient le userform lui est bien caché !

Une question pourquoi tes sorties sont en CSV et pas en format Excel ?

C'est simplement que le fichier doit être réintégré dans une base et que le format obligatoire est le csv.

**Igloobel** · 21/08/2015, 10h22

Encore une proposition :

Code :

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

Application.ScreenUpdating = False

a mettre au début du code et en fin le remettre a True

tu dis

A+

PS : j'avais pas bien vu ton message

les classeurs créés sont visibles et ne s'enregistrent pas ...

Comment ça ils ne s'enregistrent pas ?

**Messager.J** · 22/08/2015, 11h21

Code :

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

Application.ScreenUpdating = False

Ce code marche parfaitement ! Merci !!

Comment ça ils ne s'enregistrent pas ?

Erreur de ma part, j'avais mis "End" avant l'enregistrement des fichiers, forcement, cela ne marchait pas ...

En enlevant le "End", les fichiers s'enregistrent bien. Cependant quand je souhaite réouvrir ce fichier manuellement, j'ai un message d'erreur :

le format et l'extension du fichier ne correspondent pas. Le fichier peut présenter un risque ou avoir été endommagé. Ne l'ouvrez pas, à moins que la source soit fiable. Voulez vous quand même l'ouvrir ?

J'aimerais bien faire disparaître ce message ... Mais je ne sais pas d'où provient l'erreur ! Sachant que quand je clique sur oui, mon fichier est exactement celui que j'attend !

**Igloobel** · 25/08/2015, 10h11

Envoyé par Messager.J

... J'aimerais bien faire disparaître ce message ... Mais je ne sais pas d'où provient l'erreur ! Sachant que quand je clique sur oui, mon fichier est exactement celui que j'attend !

Essaye

Code :

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

Application.DisplayAlerts = False

N'hésites pas à faire F1 sur "DisplayAlerts" cela t'expliquera comment ça marche.

Bien evidemment en fin de programme il faudra le remettre à True

A+

**Messager.J** · 26/08/2015, 20h10

En fait ce n'est pas pendant la macro que ça bug. Mais une fois celle ci fini. Si je veux vérifier mon fichier, je l'ouvre et c'est là que j'obtiens le message d'erreur. Surement que je dois mal enregistrer le fichier ...

Macro lecture de données puis ventilation selon colonne dans 2 fichiers de sortie

Excel

Discussions similaires

Partager

Partager