PB Macro sauvegarder csv

Y compris Power BI, Power Query et toute autre question en lien avec Excel
Répondre
Avatar du membre
synergy
Membre habitué
Membre habitué
Messages : 98
Inscrit le : 25 août 2014
Version d'Excel : 2010

Message par synergy » 2 janvier 2020, 12:35

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
MACRO Thomi.txt
(2.7 Kio) Téléchargé 8 fois
Testmacrothomi.xlsx
(15.62 Kio) Téléchargé 7 fois
Avatar du membre
GVIALLES
Membre dévoué
Membre dévoué
Messages : 823
Appréciations reçues : 74
Inscrit le : 28 novembre 2017
Version d'Excel : 2016, 360
Téléchargements : Mes applications

Message par GVIALLES » 3 janvier 2020, 12:29

Bonjour Synergy,

Je te propose le code suivant :

Option Explicit Sub prepaexcel() ' ' pr ... ly End Sub
Cordialement,

Gérard
Avatar du membre
GVIALLES
Membre dévoué
Membre dévoué
Messages : 823
Appréciations reçues : 74
Inscrit le : 28 novembre 2017
Version d'Excel : 2016, 360
Téléchargements : Mes applications

Message par GVIALLES » 3 janvier 2020, 12:30

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
Cordialement,

Gérard
Répondre
  • Sujets similaires
    Réponses
    Vues
    Dernier message