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

16testmacrothomi.xlsx (15.62 Ko)
15macro-thomi.txt (2.70 Ko)

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
Rechercher des sujets similaires à "macro sauvegarder csv"