Faire une boucle sur une macro

Résolu
edlyg Messages postés 13 Date d'inscription   Statut Membre Dernière intervention   -  
edlyg Messages postés 13 Date d'inscription   Statut Membre Dernière intervention   -
Bonsoir

Je viens de faire une macro qui me permet d'aller chercher dans un dossier un fichier .csv de le traiter dans Excell puis de l'extraire et de l'enregistrer dans un nouveau dossier en .xls.
Ca fonctionne plutôt bien.

Par contre dans mon dossier source il y a 24 fichiers que j'aimerai pouvoir traiter en boucle.
Je vais chercher le fichier 1 j'applique la macro existante j'enregistre je ferme et je recommence avec le fichier 2 jusqu'au fichier 24.

Comment faut-il que je modifie la macro existante pour que la boucle puisse s'opérer ?
Voici le code de la macro existante

Sub MiseEnForme()
'
' MiseEnForme Macro
'

'
Sheets("Données entrée").Select
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;C:\Conversion 10 Hz - 1Hz\Fichiers 10 Hz à convertir\2018-08-08 - Enregistrement - Carto V6 Run 2.csv" _
, Destination:=Range("$A$1"))
.Name = "2018-08-08 - Enregistrement - Carto V6 Run 2_1"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 850
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = True
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
Sheets("TCD").Select
Selection.Copy
Sheets("Données sortie").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Columns("A:A").Select
Application.CutCopyMode = False
Selection.Insert Shift:=xlToRight
Range("B4").Select
Selection.Copy
Range("A4").Select
ActiveSheet.Paste
Range("B4").Select
Range(Selection, Selection.End(xlDown)).Select
Range("A3872").Select
ActiveSheet.Paste
Selection.End(xlUp).Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.FillDown
ActiveWindow.SmallScroll Down:=10
Rows("3873:3873").Select
Selection.ClearContents
Range("A3872").Select
Selection.End(xlUp).Select
Selection.End(xlUp).Select
Sheets("Données entrée").Select
Range("C1:C2").Select
Range(Selection, Selection.End(xlToRight)).Select
Range("C1:AQ2").Select
Selection.Copy
Sheets("Données sortie").Select
Range("C1").Select
ActiveSheet.Paste
Range("B1:B2").Select
Application.CutCopyMode = False
Selection.ClearContents
Rows("3:4").Select
Selection.Delete Shift:=xlUp
Sheets("Données sortie").Select
Sheets("Données sortie").Copy
chemin = "C:\Conversion 10 Hz - 1Hz\Fichiers convertis 1 Hz\"
Do
fichier = "Conversion 10Hz 1Hz N°1" & Index + 1 & ".xls"
MyFile = Dir(chemin & fichier)
If MyFile <> "" Then Index = Index + 1
Loop Until MyFile = ""

ActiveWorkbook.SaveAs filename:=chemin & fichier, FileFormat:=xlNormal
ActiveWorkbook.Close
Cells.Select
Selection.ClearContents
Sheets("Données entrée").Select
Cells.Select
Range("R1").Activate
Selection.QueryTable.Delete
Selection.ClearContents

End Sub


Bien sûr la question m'a été posée Vendredi soir et comme par hasard c'est pour hier lol
Si quelq'un peut m'aider à trouver une solution j'en serai très reconnaissante.

Bonne soirée

A voir également:

1 réponse

Réponse 1 / 1
yg_be Messages postés 23541 Date d'inscription   Statut Contributeur Dernière intervention   Ambassadeur 1 584
 
bonjour,
d'une part, tu écris que tu nous montres la macro existante, qui ne travaille que sur un fichier. d'autre part, j'y vois une boucle do. N'est-ce pas contradictoire?
avant tout, ajouter "option explicit" en début de module.
la première chose à faire, c'est de modifier la macro et de mettre dans des variables tous les éléments qui vont varier pendant la boucle. par exemple: 
dim nomfichier as string
nomfichier="2018-08-08 - Enregistrement - Carto V6 Run 2.csv"
With ActiveSheet.QueryTables.Add(Connection:= _
    "TEXT;C:\Conversion 10 Hz - 1Hz\Fichiers 10 Hz à convertir\" & nomfichier _
    , Destination:=Range("$A$1"))
Quand tu auras fait cela, partages ton code, et indique clairement quelles sont les variables à changer dans la boucle.
0
edlyg Messages postés 13 Date d'inscription   Statut Membre Dernière intervention  
 
Bonsoir

Merci pour ta réponse

Initialement je devais faire tourner ma macro pour un fichier par jour et la boucle me permettait d’enregistrer le nouveau fichier généré en incrémentant le nom du fichier sans risquer d'écraser les fichiers déjà existants.
Mais il y a sûrement un moyen plus simple de faire. Je débute donc je bidouille !

Depuis le besoin a évolué.
J'ai désormais une vingtaine de fichiers "source" à traiter. Du coup je voudrais pouvoir le faire automatiquement sachant que à chaque fichier source en .csv doit correspondre un fichier de sortie en .xls
L'idée est donc j'ouvre le fichier dans lequel se trouve ma macro j'importe le premier fichier je le traite j'exporte et sauvegarde le résultat et une boucle me permets de continuer avec le fichier suivant sans être obligée de relancer la macro à chaque fois.

Je ne sais pas si je suis très claire
0
yg_be Messages postés 23541 Date d'inscription   Statut Contributeur Dernière intervention   1 584 > edlyg Messages postés 13 Date d'inscription   Statut Membre Dernière intervention  
 
cela devient plus clair.
comment peut-on déterminer quels sont les fichiers csv à traiter?
0
Pseudo...
 
À la racine d’un C j’ai un répertoire dans lequel se trouve un dossier contenant les fichiers csv
0
baladur13 Messages postés 47777 Date d'inscription   Statut Modérateur Dernière intervention   13 684 > Pseudo...
 
Bonjour,
Prière de renseigner la case pseudo avant de répondre.
Merci
0
yg_be Messages postés 23541 Date d'inscription   Statut Contributeur Dernière intervention   1 584 > Pseudo...
 
suggestion: 
Option Explicit

Sub MiseEnForme()
Dim ficcsv As String, rep As String
'rep = ThisWorkbook.Path & "\"
rep = "C:\Conversion 10 Hz - 1Hz\Fichiers 10 Hz à convertir\"
ficcsv = Dir(rep & "*.csv")
Do Until ficcsv = ""
    Call unfichiercsv(rep & ficcsv)
    ficcsv = Dir("")
Loop
End Sub
Private Sub unfichiercsv(fichiercsv As String)
Dim chemin, Index, fichier, Myfile
Sheets("Données entrée").Select
With ActiveSheet.QueryTables.Add(Connection:= _
    "TEXT;" & fichiercsv _
    , Destination:=Range("$A$1"))
    .Name = "2018-08-08 - Enregistrement - Carto V6 Run 2_1"
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .TextFilePromptOnRefresh = False
    .TextFilePlatform = 850
    .TextFileStartRow = 1
    .TextFileParseType = xlDelimited
    .TextFileTextQualifier = xlTextQualifierDoubleQuote
    .TextFileConsecutiveDelimiter = False
    .TextFileTabDelimiter = True
    .TextFileSemicolonDelimiter = True
    .TextFileCommaDelimiter = True
    .TextFileSpaceDelimiter = False
    .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
    1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
    .TextFileTrailingMinusNumbers = True
    .Refresh BackgroundQuery:=False
End With
Sheets("TCD").Select
Selection.Copy
Sheets("Données sortie").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Columns("A:A").Select
Application.CutCopyMode = False
Selection.Insert Shift:=xlToRight
Range("B4").Select
Selection.Copy
Range("A4").Select
ActiveSheet.Paste
Range("B4").Select
Range(Selection, Selection.End(xlDown)).Select
Range("A3872").Select
ActiveSheet.Paste
Selection.End(xlUp).Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.FillDown
ActiveWindow.SmallScroll Down:=10
Rows("3873:3873").Select
Selection.ClearContents
Range("A3872").Select
Selection.End(xlUp).Select
Selection.End(xlUp).Select
Sheets("Données entrée").Select
Range("C1:C2").Select
Range(Selection, Selection.End(xlToRight)).Select
Range("C1:AQ2").Select
Selection.Copy
Sheets("Données sortie").Select
Range("C1").Select
ActiveSheet.Paste
Range("B1:B2").Select
Application.CutCopyMode = False
Selection.ClearContents
Rows("3:4").Select
Selection.Delete Shift:=xlUp
Sheets("Données sortie").Select
Sheets("Données sortie").Copy
chemin = "C:\Conversion 10 Hz - 1Hz\Fichiers convertis 1 Hz\"
Do
    fichier = "Conversion 10Hz 1Hz N°1" & Index + 1 & ".xls"
    Myfile = Dir(chemin & fichier)
    If Myfile <> "" Then Index = Index + 1
Loop Until Myfile = ""

ActiveWorkbook.SaveAs Filename:=chemin & fichier, FileFormat:=xlNormal
ActiveWorkbook.Close
Cells.Select
Selection.ClearContents
Sheets("Données entrée").Select
Cells.Select
Range("R1").Activate
Selection.QueryTable.Delete
Selection.ClearContents

End Sub
0

Discussions similaires

Transformer un chiffre en lettres dans excel sans macro
vincentphilippos -
tontong -

6 réponses