Convertir csv en xls avec des colonnes ajoutées

1 pièce(s) jointe(s)

Salut tout le monde
tous les mois je reçois un fichier csv le nombre de colonnes et toujours le même change le nombre de lignes.
Je voudrais obtenir le même fichier en XLS à partir de la ligne a2 avec l'insertion des colonnes à fond jaun .Et puis que je supprime de la colonne H les lignes qui ont des dates inférieures à A2 et les copie dans la feuille cex

je joins les 2 fichiers

1 pièce(s) jointe(s)

Proposition

Bonjour
voici un fichier qui traite ce que j'ai compris de la demande

il faut renseigner l'emplacement B1 de la feuille "Réglages et Macro" sans oublier le \ à la fin
(c'est le dossier dans lequel il y a le CSV)

Ensuite appuyer sur le smiley
renseigner la date A1 et le % en AC1

La macro enregistre le fichier demandé sur le bureau

PS : j'ai mis en pause dans le VBA la formule RECHERCHEV de la fin du tableau car elle fait réf à un fichier sur votre PC

Code:

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
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
Sub Choix_CSV()
 
Dim MOI As String
Dim Nb_Feuilles As Integer
MOI = ActiveWorkbook.Name
Nb_Feuilles = ActiveWorkbook.Sheets.Count
 
 
' Sélection d'un dossier de base :
Application.FileDialog(msoFileDialogOpen).InitialFileName = Range("mon_dossier_source")
' Affichage d'un titre particulier dans la boite de dialogue :
Application.FileDialog(msoFileDialogOpen).Title = "Sélectionnez le CSV"
Application.FileDialog(msoFileDialogOpen).InitialFileName = Range("mon_dossier_source") & "*.csv*"
 
Application.FileDialog(msoFileDialogOpen).Show
Range("Nom_Fichier").Value = Dir(Application.FileDialog(msoFileDialogFilePicker).SelectedItems(1))
 
'Ouvrir le CSV et l'importer ici
Workbooks.OpenText Filename:=Range("Mon_Dossier_Source") & Range("Nom_Fichier"), Origin:=xlWindows, _
        StartRow:=1, DataType:=xlDelimited, Local:=True, Semicolon:=True, Comma:=True
 
Sheets(1).Copy After:=Workbooks(MOI).Sheets(Nb_Feuilles)
ActiveSheet.Name = "Foglio1" 'à mettre à jour si necessaire
Windows(Range("Nom_Fichier").Value).Close
 
'ajout d'une ligne en haut et des colonnes demandées
    Rows("1:1").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
 
    Columns("D:D").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("D2").Value = "p in forza"
    Columns("R:R").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("R2").Value = "verifica rivalutazione"
    Columns("S:S").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("S2").Value = "differenza"
    Columns("T:T").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("T2").Value = "note"
    Columns("X:X").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("X2").Value = "controllo"
    Columns("Z:Z").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("Z2").Value = "controllo"
    Columns("AA:AA").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("AA2").Value = "note"
    Columns("AC:AC").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("AC2").Value = "controllo"
    Columns("AD:AD").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("AD2").Value = "diff."
    Columns("AV:AV").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("AV2").Value = "controllo"
    Columns("Bk:Bk").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("Bk2").Value = "controllo"
    Columns("Bo:Bo").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("Bo2").Value = "controllo"
    Columns("Bp:Bp").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("Bp2").Value = "TFR_13ma"
 
    'fond jaune
        Range("D2, R2, S2, T2, X2, Z2, AA2, AC2, AD2, AV2, Bk2, Bo2, Bp2").Select
            With Selection.Interior
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
                .Color = 65535
                .TintAndShade = 0
                .PatternTintAndShade = 0
            End With
 
    'Gras
        Range("Bk2, Bo2, Bp2").Select
        Selection.Font.Bold = True
 
'Mise en place des formules et formats
 
Dim ma_dern_ligne As String
ma_dern_ligne = Range("A" & Rows.Count).End(xlUp).Row
 
    Range("S3").Select
    Selection.FormulaR1C1 = "=RC[-4]-RC[-1]"
        Selection.AutoFill Destination:=Range("S3:S" & ma_dern_ligne)
 
    Range("X3").Select
    Selection.FormulaR1C1 = "=RC[-2]+RC[-1]-RC[-3]"
        Selection.AutoFill Destination:=Range("x3:x" & ma_dern_ligne)
 
    Range("Z3").Select
    Selection.FormulaR1C1 = "=RC[-4]-RC[-1]"
        Selection.AutoFill Destination:=Range("z3:z" & ma_dern_ligne)
 
    Range("AC3").Select
    Selection.FormulaR1C1 = "=RC[-14]*R1C"
        Selection.AutoFill Destination:=Range("ac3:ac" & ma_dern_ligne)
    Range("ac3:ac" & ma_dern_ligne).Select
            With Selection.Font
                .Color = -16776961
                .TintAndShade = 0
            End With
 
    Range("AD3").Select
    Selection.FormulaR1C1 = "=RC[-2]-RC[-1]"
        Selection.AutoFill Destination:=Range("ad3:ad" & ma_dern_ligne)
        Range("ad3:ad" & ma_dern_ligne).Select
            With Selection.Font
                .Color = -16776961
                .TintAndShade = 0
            End With
 
    Range("AV3").Select
    Selection.FormulaR1C1 = _
        "=RC[-36]+RC[-33]+RC[-27]-RC[-23]-RC[-20]-RC[-5]-RC[-2]-RC[-1]"
        Selection.AutoFill Destination:=Range("av3:av" & ma_dern_ligne)
        Range("av3:av" & ma_dern_ligne).Select
            With Selection.Font
                .Color = -16776961
                .TintAndShade = 0
            End With
 
    Range("BK3").Select
    Selection.FormulaR1C1 = _
        "=RC[-51]+RC[-48]+RC[-42]-RC[-38]-RC[-35]-RC[-20]-RC[-17]-RC[-8]-RC[-1]"
        Selection.AutoFill Destination:=Range("bk3:bk" & ma_dern_ligne)
        Range("bk3:bk" & ma_dern_ligne).Select
            With Selection.Font
                .Color = -16776961
                .TintAndShade = 0
            End With
 
    Range("BO3").Select
    Selection.FormulaR1C1 = "=RC[-5]-RC[-2]-RC[-3]"
        Selection.AutoFill Destination:=Range("bo3:bo" & ma_dern_ligne)
        'la prochaine formule je l'ai enlevée chez moi car liée à un classeur chez vous (virez les ' en début de ligne)
'    Range("BP3").Select
'    Selection.FormulaR1C1 = _
'        "=VLOOKUP(RC[-62],'H:\DATA\Finance\Paghe\ATTIVITA'' GRUPPO ACE\FONDI PAYROLL\AST_SAVOY_4414\FONDO TFR\2023\05 2023\02 Varie\[Ratei-(tredicesima_05_2023_lavorato.xlsx]CON TRAM'!C2:C29,28,0)"
'        Selection.AutoFill Destination:=Range("bo3:bo" & ma_dern_ligne)
'        Range("bo3:bo" & ma_dern_ligne).Select
'            With Selection.Font
'                .Color = -16776961
'                .TintAndShade = 0
'            End With
'        Selection.Font.Bold = True
 
' message pour mettre une date en A1 et un % en AC1
 
Range("A1").Value = Application.InputBox("Entrez la date A1 SVP (Format dd/mm/yy)", "Date requise", FormatDateTime(Date, vbShortDate), Type:=1)
Range("A1").NumberFormat = "dd/mm/yyyy"
 
Range("AC1").Value = InputBox("% en AC1 SVP (sans le symbole %)", "% requis") / 100
    Range("AC1").NumberFormat = "0.00%"
    Range("AC1").Select
    With Selection.Font
        .Color = -16776961
        .TintAndShade = 0
    End With
 
'Creer la feuille CEX et reporter les entetes
    Sheets.Add After:=ActiveSheet
    ActiveSheet.Name = "CEX"
 
    Sheets("Foglio1").Select
    Rows("2:2").Select
    Selection.Copy
    Sheets("CEX").Select
    Rows("1:1").Select
    ActiveSheet.Paste
 
    Sheets("Foglio1").Select
 
'On sort les données dépassées en colonne H
    Dim i
 
    For i = 3 To ma_dern_ligne '3 car la 1e ligne commence à 3
        If Range("A1").Value <= Range("H" & i).Value Or Range("H" & i).Value = "" Then
        'rien
        Else 'je coupe et je place en feuille CEX
            Rows(i & ":" & i).Select
            Selection.Cut
            Sheets("CEX").Select
                    Dim Dern_Ligne_CEX
                    Dern_Ligne_CEX = Sheets("CEX").Range("A" & Rows.Count).End(xlUp).Row + 1
                    Rows(Dern_Ligne_CEX & ":" & Dern_Ligne_CEX).Select
            ActiveSheet.Paste
            Sheets("Foglio1").Select
            Selection.Delete Shift:=xlUp
            i = i - 1 'sinon il saute une ligne
        End If
    Next i
 
'on vire les colonnes en trop pour retomber au format d'origine
    Sheets("CEX").Select
    Range("D:D,R:R,S:S,T:T,X:X,Z:Z,AA:AA,AC:AC,AD:AD,AV:AV,BK:BK,BO:BO,BP:BP").Select
    Selection.Delete Shift:=xlToLeft
    Range("A1").Select
 
'Sauvegarde en xlsx sur le bureau
Application.DisplayAlerts = False
 
Sheets("Réglages et Macro").Delete 'à virer si la feuille n'exite plus dans ton produit fini
 
Dim Chemin As String
Chemin = CreateObject("wscript.shell").specialfolders("desktop") & "\"
ActiveWorkbook.SaveAs Filename:=Chemin & "Mon fichier du " & Format(Now, "yyyymmdd") & ".xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
Application.DisplayAlerts = True
 
MsgBox ("Ok terminé"), , "Fichier Prêt sur le bureau"
 
 
End Sub

bonjour et merci
je dirais que ça marche
J'ai mis en B1 le chemin où se trouve le fichier csv exact ?
C:\Users\luis\Desktop\Nouva cartella\

Réponse

Citation:

Envoyé par lourid

bonjour et merci
je dirais que ça marche
J'ai mis en B1 le chemin où se trouve le fichier csv exact ?
C:\Users\luis\Desktop\Nouva cartella\

Bonjour
oui le dossier indiqué est celui qui est proposé à l'ouverture lorsqu'on lance la macro
habituellement lorsque j'ai ce genre de demande, les personnes conservent leurs CSV dans un seul et même dossier.

Merci beaucoup, je vais mettre resolu