executer automatiquement une macro sur plusieurs fichiers et les copier dans d'autres

M

MIMI28CG

XLDnaute Nouveau
Bonjour,

J'aimerais savoir si cela est possible d'executer automatiquement une macro par un bouton sur plusieurs fichiers et que celle-ci la copie et la colle automatiquement.

Je vous explique mon problème :
J'extrais plusieurs fichiers depuis un site internet en .xls (chaque semaine) mais dans un fichier zip. Ces fichiers sont des données brut et mes macros (selon le type d'extraction) modifie les données brut en format presentable avec des formules simples.
Donc chaque semaine, je perds 2 jours à mettre à jour mes reports.

Donc il y a 24 fichiers extraits et ces 24 fichiers doivent etre copier dans 24 autres fichiers mais sur un onglet specifique. (je ne sais pas si je suis clair).

En fait, chaque fichier extrait, je l'execute manuellement, que je copie (selection de tout la feuille) et que je colle sur mon autre fichier fini sur un onglet (ce fichier fini comprends plusieurs onglets d'autres macro).

Et ce que j'aimerais faire, c'est que lorsque j'extrais mes données, j'appuis sur un bouton et qui execute automatiquement ma macro sur les 24 fichiers extraits puis copie-colle sur mes 24 autres fichiers de l'onglet de cette macro.

Voici un exemple de macro que j'ai fait :

PHP: 
Sub TOP10magUG()
'
' TOP10magUG Macro
'
    Columns("A:A").EntireColumn.AutoFit
    Columns("B:B").EntireColumn.AutoFit
    Columns("C:C").EntireColumn.AutoFit
    Columns("D:D").EntireColumn.AutoFit
    Columns("D:I").Select
    Columns("D:I").EntireColumn.AutoFit
    Rows("3:3").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("A4").Select
    ActiveCell.FormulaR1C1 = "LIBELLE UG"
    Range("B4").Select
    ActiveCell.FormulaR1C1 = "MARQUE"
    Range("A4").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Rows("4:4").RowHeight = 23
    Selection.Copy
    Range("B4:I4").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    ActiveWindow.SmallScroll ToRight:=1
    Range("A4:I4").Select
    Range("I4").Activate
    Selection.Font.Bold = True
    ActiveWindow.SmallScroll ToRight:=-5
    Range("A4:I14").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Rows("4:4").EntireRow.AutoFit
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Range("A4:I4").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Range("C4").Select
    Columns("D:D").EntireColumn.AutoFit
    Columns("D:D").ColumnWidth = 12.57
    Columns("D:D").EntireColumn.AutoFit
    ActiveWindow.SmallScroll ToRight:=1
    ActiveWindow.ScrollColumn = 1
    Range("A2").Select
    Selection.Font.Bold = True
    Range("A4:I4").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent3
        .TintAndShade = 0.399975585192419
        .PatternTintAndShade = 0
    End With
    Range("A4:I4").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 2577696
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    With Selection.Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
    ActiveWindow.DisplayGridlines = False
    Range("A3").Select
    ActiveWindow.DisplayZeros = False
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "L'analyse ci-dessous porte sur la semaine"
    Range("A1").Select
    With Selection.Font
        .Name = "Arial"
        .Size = 14
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = 1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 2577696
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    With Selection.Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
    Range("A1:C1").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    ActiveWindow.Zoom = 80
    Range("D1").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 2577696
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    With Selection.Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
    With Selection.Font
        .Name = "Arial"
        .Size = 14
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    Selection.Font.Bold = True
    Range("D1").Select
    ActiveCell.FormulaR1C1 = "S "
    Range("D2").Select
    Columns("D:D").EntireColumn.AutoFit
    Columns("E:E").EntireColumn.AutoFit
    Columns("F:F").EntireColumn.AutoFit
    Columns("G:G").EntireColumn.AutoFit
    Cells.Select
    Cells.EntireColumn.AutoFit
    Columns("E:E").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("E5").Select
    ActiveCell.FormulaR1C1 = "=RC[-1]/100"
    Range("E5").Select
    Selection.AutoFill Destination:=Range("E5:E14"), Type:=xlFillDefault
    Range("E5:E14").Select
    Selection.Copy
    Range("D5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("E:E").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
    Range("D5:D14").Select
    Selection.NumberFormat = "0.00%"
    Range("E5").Select
    Selection.Copy
    Range("G5:G14").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Range("A4:I14").Select
    Range("I14").Activate
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Columns("F:F").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("F5").Select
    ActiveCell.FormulaR1C1 = "=+RC[-1]*1.196"
    Range("F5").Select
    Selection.AutoFill Destination:=Range("F5:F14"), Type:=xlFillDefault
    Range("F5:F14").Select
    Selection.Copy
    Range("E5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("F:F").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
    Columns("H:H").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("H5").Select
    ActiveCell.FormulaR1C1 = "=+RC[-1]*1.196"
    Range("H5").Select
    Selection.AutoFill Destination:=Range("H5:H14"), Type:=xlFillDefault
    Range("H5:H14").Select
    Selection.Copy
    Range("G5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("H:H").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
     Range("H4").Select
    ActiveCell.FormulaR1C1 = "VENTE " & Chr(10) & "en UVC"
    With ActiveCell.Characters(Start:=1, Length:=13).Font
        .Name = "Arial"
        .FontStyle = "Gras"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    Range("I4").Select
    ActiveCell.FormulaR1C1 = "STOCK MAGASIN " & Chr(10) & "en UVC"
    With ActiveCell.Characters(Start:=1, Length:=21).Font
        .Name = "Arial"
        .FontStyle = "Gras"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    Range("G4").Select
    ActiveCell.FormulaR1C1 = "VENTE" & Chr(10) & " MAGASIN €"
    With ActiveCell.Characters(Start:=1, Length:=16).Font
        .Name = "Arial"
        .FontStyle = "Gras"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    Range("F4").Select
    ActiveCell.FormulaR1C1 = "VALORISATION MANQUE" & Chr(10) & " A GAGNER en UVC"
    With ActiveCell.Characters(Start:=1, Length:=36).Font
        .Name = "Arial"
        .FontStyle = "Gras"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    Range("E4").Select
    ActiveCell.FormulaR1C1 = "VALORISATION DU" & Chr(10) & " MANQUE A GAGNER TTC €"
    With ActiveCell.Characters(Start:=1, Length:=38).Font
        .Name = "Arial"
        .FontStyle = "Gras"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    Range("D4").Select
    ActiveCell.FormulaR1C1 = "TAUX " & Chr(10) & "DISPONIBILITE"
    With ActiveCell.Characters(Start:=1, Length:=19).Font
        .Name = "Arial"
        .FontStyle = "Gras"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    Columns("A:I").Select
    Columns("A:I").EntireColumn.AutoFit
    Range("L12").Select
    ActiveWindow.ScrollColumn = 1
    Range("A19").Select
    End With
End Sub

Merci par avance pour votre aide.
 

Discussions similaires

H
  • Question
XL 2016 Mettre des titres avec une mise en forme spécifique
Réponses
1
Affichages
389
vgendron
vgendron
Nicolas JACQUIN
  • Question
XL 2021 Exportation feuille msgbox yes no avec module Thisworkbook
2
Réponses
21
Affichages
880
Nicolas JACQUIN
Nicolas JACQUIN
R
  • Question
XL 2016 Rendre plus lisible un code VBA
2
Réponses
23
Affichages
1 K
TooFatBoy
TooFatBoy
L
  • Question
Microsoft 365 Changement de couleurs de cellules dans plusieurs feuilles suite à une modification
Réponses
4
Affichages
562
lolo_excelbeginner
L
K
  • Question
XL 2019 Organiser le code VBA
Réponses
9
Affichages
753
Kevin38
K
R
  • Résolu(e)
XL 2019 creer une macro pour copier des info d un onglet a un autre dans le meme classeur
Réponses
4
Affichages
492
robpellan52
R
Syracoti
  • Résolu(e)
XL 2016 Changer de feuille dans une macro
2
Réponses
28
Affichages
3 K
Staple1600
Staple1600
S
  • Résolu(e)
XL 2019 VBA pour créer un nouvel onglet
Réponses
2
Affichages
632
sum01
S
Usine à gaz
  • Résolu(e)
XL 2019 Ne pas utiliser les MFC
Réponses
5
Affichages
500
Usine à gaz
Usine à gaz
P
  • Question
XL 2019 appliquer une macro sur n'importe quel fichier excel
2
Réponses
22
Affichages
3 K
pasquetp
P

Membres actuellement en ligne

19 membres et 191 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
314 626
Messages
2 111 294
Membres
111 093
dernier inscrit
Yvounet