Boucle Macro VBA pour renommer er enregistrer
Résolu/Fermé
jannot1986
Messages postés
9
Date d'inscription
dimanche 20 janvier 2019
Statut
Membre
Dernière intervention
25 septembre 2019
-
29 avril 2019 à 03:30
jannot1986 Messages postés 9 Date d'inscription dimanche 20 janvier 2019 Statut Membre Dernière intervention 25 septembre 2019 - 29 avril 2019 à 20:10
jannot1986 Messages postés 9 Date d'inscription dimanche 20 janvier 2019 Statut Membre Dernière intervention 25 septembre 2019 - 29 avril 2019 à 20:10
A voir également:
- Boucle Macro VBA pour renommer er enregistrer
- Audacity enregistrer son pc - Guide
- Renommer plusieurs fichiers en même temps - Guide
- Telecharger macro convertir chiffre en lettre excel - Télécharger - Tableur
- Enregistrer en pdf - Guide
- Enregistrer son ecran - Guide
1 réponse
cs_Le Pivert
Messages postés
7904
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
14 août 2024
729
29 avril 2019 à 10:41
29 avril 2019 à 10:41
Bonjour,
comme ceci:
comme ceci:
Option Explicit 'Déclaration des Variables Dim Repertoire As String Dim LigneTotal As Long Dim Derligne As Long Dim i As Integer Sub Operation_remarquables_eumm() Application.ScreenUpdating = False Application.DisplayAlerts = False Worksheets("conversion").Visible = True Worksheets("conversion").Select Rows("1:1000000").Select Selection.Clear i = 1 ChDir "C:\Users\JANNOT\Desktop\operation remarquables EUMM\ETATS EUMM" Repertoire = Dir("C:\Users\JANNOT\Desktop\operation remarquables EUMM\ETATS EUMM\*.xlsx") While Len(Repertoire) > 0 Workbooks.Open "C:\Users\JANNOT\Desktop\operation remarquables EUMM\ETATS EUMM\" & Repertoire Columns("A:A").Select Selection.Copy Workbooks("Macro traitement operations remarquables eumm.xlsm").Activate Worksheets("conversion").Visible = True Worksheets("conversion").Select ActiveSheet.Paste Columns("A:A").Select Application.CutCopyMode = False Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _ Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _ :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _ Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1 _ ), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array _ (20, 1), Array(21, 1), Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 1)), _ TrailingMinusNumbers:=True LigneTotal = ActiveSheet.UsedRange.Rows.Count - 2 Range("A2:Y" & LigneTotal).Copy Workbooks.Add Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _ xlNone, SkipBlanks:=False, Transpose:=False Application.CutCopyMode = False ActiveWorkbook.SaveAs Filename:= _ "C:\Users\JANNOT\Desktop\operation remarquables EUMM\conversion\fichier" & i & ".xlsx", FileFormat:= _ xlOpenXMLWorkbook, CreateBackup:=False ActiveWindow.Close Workbooks(Repertoire).Close Repertoire = Dir i = i + 1 Wend End Sub
29 avril 2019 à 20:10
ça marche.