Chers tous,
Nouveau sur ce forum, je me permets de vous demander de l'aide concernant une macro sur un de mes fichiers.
Le souci est que : lors de mon export CSV, les fichiers créés ( et ils le sont bien ) contiennent aléatoirement en début et fin de lignes des " ( guillemets ), quelques lignes sont correctes !
Ma macro crée des feuilles en fonction d'une cellule ( je découpe une feuille de 6000 lignes en feuilles de 200 lignes maximum ), nomme les feuilles pour mon export CSV. Tout fonctionne, jusqu'au fichier CSV qui contient ses fâcheux " ( guillemets ). Ci-dessous ma macro :
Si vous avez une once d'idée, je suis preneur.
A+
Nouveau sur ce forum, je me permets de vous demander de l'aide concernant une macro sur un de mes fichiers.
Le souci est que : lors de mon export CSV, les fichiers créés ( et ils le sont bien ) contiennent aléatoirement en début et fin de lignes des " ( guillemets ), quelques lignes sont correctes !
Ma macro crée des feuilles en fonction d'une cellule ( je découpe une feuille de 6000 lignes en feuilles de 200 lignes maximum ), nomme les feuilles pour mon export CSV. Tout fonctionne, jusqu'au fichier CSV qui contient ses fâcheux " ( guillemets ). Ci-dessous ma macro :
Code:
Sub nouvellePages()
Dim sh As Object, cel As Range
Application.ScreenUpdating = False
For Each sh In Sheets
If sh.Name <> "base" Then
Application.DisplayAlerts = False
sh.Delete
End If
Next sh
Range("A1:A" & [C65000].End(xlUp).Row).Name = "clients"
Range("A1:J" & [C65000].End(xlUp).Row).Name = "mabase"
For Each cel In Range("K1:K" & [C65000].End(xlUp).Row)
cel.Value = Replace(cel.Value, " ", " ")
cel.Value = Replace(cel.Value, " ;", ";")
' cel.Value = Replace(cel.Value, ", ", "VVV")
Next cel
[L1] = [A1]
Range("clients").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _
"L1"), Unique:=True
For Each cel In Range("L2:L" & [L65000].End(xlUp).Row)
Sheets("base").[L2] = cel
Sheets.Add after:=Sheets(Sheets.Count)
With ActiveSheet
.Name = cel
.[A1].Value = Sheets("base").[B1].Value
Range("mabase").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Sheets( _
"base").Range("L1:L2"), CopyToRange:=.Range("A1"), Unique:=False
End With
Next cel
Sheets("base").Select
Columns(12).ClearContents
Dim she As Worksheet, cell As Range
For Each she In Worksheets
she.Copy
' For Each cell In Range("A1:A" & [A65000].End(xlUp).Row)
' cell.Value = Replace(cell.Value, "VVV", ", ")
' Next cell
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs fileName:=she.Name & ".csv", FileFormat:=xlCSV, CreateBackup:=False
ActiveWorkbook.Close savechanges:=False
Application.DisplayAlerts = True
' ActiveWorkbook.Close Savechanges:=False
Next she
End SubSi vous avez une once d'idée, je suis preneur.
A+