PB Macro sauvegarder csv
Salut le forum,
J´ai un fichier avec X onglets.
J´ai creé une macro pour faire modification sur un onglet:
- j´aimerai modifier cette macro pour que ces modifications s´appliquent sur tous les onglets du livre, et pas seulement celui ou je suis.
Ensuite, j´ai une macro pour sauvegar chaque onglets en un fichier CSV:
- Le probleme est que avec cette macro chaque ligne de mon csv commence par " et finit par " . Comment supprimer ces deux " ?
- J´aimerais que au lieu de me demander ou garder les fichers CSV, le VBA les garde directement dans le même dossier sans poser la question.
Merci pour l´aide
Je vous joins le fichier excel et ma macro en un libro text
Bonjour Synergy,
Je te propose le code suivant :
Oups...
Option Explicit
Sub prepaexcel()
'
' prepaexcel Macro
'
' Acceso directo: CTRL+p
'
Dim path As String
' each sheet reference
Dim Sheet As Worksheet
' Local Range Reference
Dim oRange As Range, oCell As Range
' path to output to
Dim OutputPath As String
' name of each csv
Dim OutputFile As String
' Last row number
Dim lLastRow As Long
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
' ask the user where to save individual CSV
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
.Title = "Please, select the folder where to save the CSVs files..."
.Show
If .SelectedItems.Count > 0 Then
OutputPath = .SelectedItems(1)
Else
OutputPath = ""
End If
End With
'If no path has been selected, end of job...
If Len(OutputPath) = 0 Then
Exit Sub
End If
On Error GoTo Heaven
' modify and save in CVS format each sheet
For Each Sheet In ActiveWorkbook.Sheets
'Search for last row with data in column "A"
lLastRow = Sheet.Cells(Sheet.Rows.Count, "A").End(xlUp).Row
'Add a new column for "Location"
Set oRange = Sheet.UsedRange.Columns(5)
oRange.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
'Set new column's title
Sheet.Cells(1, 5).Value = "LOCATE"
'Set value for each cell in new column's data
Set oRange = Sheet.Range(Sheet.Cells(2, 5), Sheet.Cells(lLastRow, 5))
For Each oCell In oRange.Cells
oCell.Value = "IT"
Next
'Modify value for each cell of "ctel" column.
Set oRange = Sheet.Range(Sheet.Cells(2, 6), Sheet.Cells(lLastRow, 6))
For Each oCell In oRange.Cells
oCell.Value = "'39" & oCell.Value
Next
'Set CSV file name
OutputFile = OutputPath & "\" & Sheet.Name & ".csv"
'make a new CSV with this sheet's data
Sheet.SaveAs Filename:=OutputFile, FileFormat:=xlCSV, CreateBackup:=False
Next
MsgBox "All sheets have been saved to individual CSV files", vbExclamation, "END OF JOB"
Finally:
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
ActiveWorkbook.Close False
Exit Sub
Heaven:
MsgBox "Couldn't save all sheets to CSV." & vbCrLf & _
"Source: " & Err.Source & " " & vbCrLf & _
"Number: " & Err.Number & " " & vbCrLf & _
"Description: " & Err.Description & " " & vbCrLf, vbCritical, "ERROR"
GoTo Finally
End Sub