Application d'une macro sur plusieurs feuilles
Bonjour à tous,
J'espère que vous allez bien.
Pourriez-vous me donner un coup de pouce avec une macro pour qu'elle ne soit pas trop longue.
Je m'occupe de calculer le CA AMAZON tous les mois et les exports sont différents donc j'ai besoin d'appliquer une macro pour différentes feuilles.
Je suis en train de faire une mise en page qui me permettrai de commencer directement l'analyse des informations de chaque pays.
Rows("1:6").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp
Columns("A:A").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
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)), TrailingMinusNumbers:=True
Columns("I:I").Select
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.EntireRow.Delete
Je voudrais appliquer cette macro sur les feuilles : AMZN DE / AMZN FR / AMZN UK / AMZN ES / AMZN IT.
Je vous joint un fichier excel avec des données que j'ai créé pour l'exemple.
Je vous remercie de toute l'attention que vous porterez à ma demande.
Bonjour
test déjà avec cette macro car la tienne dur
Sub Macro1()
Application.ScreenUpdating = False
Columns("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
Rows("1:6").Delete
Range("A1").Select
End Sub
A+
Maurice
Bonjour
test déjà avec cette macro car la tienne dur
Sub Macro1() Application.ScreenUpdating = False Columns("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _ Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _ :=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True Rows("1:6").Delete Range("A1").Select End Sub
A+
Maurice
J'ai modifié la macro, merci beaucoup pour l'optimisation Archer !
Il reste toujours le problème de l'application de cette macro sur les feuilles AMZN DE / AMZN UK / AMZN FR / AMZN ES / AMZN IT.
Ou si vous avez une ligne de macro pour appliquer la macro aux feuilles sélectionnés, je suis preneur aussi.
Merci beaucoup.
Bonjour à tous,
Quelqu'un aurait-il une solution ?
Voilà le code VBA utilisé actuellement.
Sub mise_en_page_csv_pays()
'
' mise_en_page_csv Macro
'
Application.ScreenUpdating = False
Columns("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
Rows("1:6").Delete
Columns("I:I").Select
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.EntireRow.Delete
Columns("M:M").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("M1").Select
ActiveCell.FormulaR1C1 = "Names"
Dim DL As Integer
DL = Cells(Application.Rows.Count, "A").End(xlUp).Row
Range("M2:M" & DL).FormulaR1C1 = "=IFERROR(VLOOKUP(RC4,EU!C1:C12,12,FALSE),"""")"
Range("M2").AutoFill Destination:=Range("M2:M" & DL), Type:=xlFillDefault
End Sub
Bonjour
ta macro efface tout tu a pas fait des essais a revoir
a voir
Sub Test()
Onglet = Array("AMZN DE", "AMZN FR", "AMZN UK", "AMZN ES", "AMZN IT")
Application.ScreenUpdating = False
For I = 0 To 4
Sheets(Onglet(I)).Select
Columns("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
Rows("1:6").Delete
Columns("I:I").Select
'Selection.SpecialCells(xlCellTypeBlanks).Select
'Selection.EntireRow.Delete
Columns("M:M").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("M1").Select
ActiveCell.FormulaR1C1 = "Names"
Dim DL As Integer
DL = Cells(Application.Rows.Count, "A").End(xlUp).Row
Range("M2:M" & DL).FormulaR1C1 = "=IFERROR(VLOOKUP(RC4,EU!C1:C12,12,FALSE),"""")"
Range("M2").AutoFill Destination:=Range("M2:M" & DL), Type:=xlFillDefault
Range("A1").Select
Next I
End Sub
pour moi ses fini
A+
Maurice
Bonjour
ta macro efface tout tu a pas fait des essais a revoir
a voir
Sub Test() Onglet = Array("AMZN DE", "AMZN FR", "AMZN UK", "AMZN ES", "AMZN IT") Application.ScreenUpdating = False For I = 0 To 4 Sheets(Onglet(I)).Select Columns("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _ Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _ :=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True Rows("1:6").Delete Columns("I:I").Select 'Selection.SpecialCells(xlCellTypeBlanks).Select 'Selection.EntireRow.Delete Columns("M:M").Select Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove Range("M1").Select ActiveCell.FormulaR1C1 = "Names" Dim DL As Integer DL = Cells(Application.Rows.Count, "A").End(xlUp).Row Range("M2:M" & DL).FormulaR1C1 = "=IFERROR(VLOOKUP(RC4,EU!C1:C12,12,FALSE),"""")" Range("M2").AutoFill Destination:=Range("M2:M" & DL), Type:=xlFillDefault Range("A1").Select Next I End Sub
pour moi ses fini
A+
Maurice
Bonjour archer (Maurice),
J'espère que vous allez bien.
J'ai constaté en effet que dans le fichier test que je vous ai envoyé, cela efface tout.
C'est moi qui a mal créé la version test et je suis désolé pour cela.
Merci beaucoup pour votre aide, je vais regarder avec le code que vous m'avez envoyé.
Bonjour
ta macro efface tout tu a pas fait des essais a revoir
a voir
Sub Test() Onglet = Array("AMZN DE", "AMZN FR", "AMZN UK", "AMZN ES", "AMZN IT") Application.ScreenUpdating = False For I = 0 To 4 Sheets(Onglet(I)).Select Columns("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _ Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _ :=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True Rows("1:6").Delete Columns("I:I").Select 'Selection.SpecialCells(xlCellTypeBlanks).Select 'Selection.EntireRow.Delete Columns("M:M").Select Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove Range("M1").Select ActiveCell.FormulaR1C1 = "Names" Dim DL As Integer DL = Cells(Application.Rows.Count, "A").End(xlUp).Row Range("M2:M" & DL).FormulaR1C1 = "=IFERROR(VLOOKUP(RC4,EU!C1:C12,12,FALSE),"""")" Range("M2").AutoFill Destination:=Range("M2:M" & DL), Type:=xlFillDefault Range("A1").Select Next I End Sub
pour moi ses fini
A+
Maurice
Bonjour archer (Maurice),
J'espère que vous allez bien.
Merci beaucoup pour votre aide.
J'ai eu indirectement une réponse à ce sujet dans un autre sujet que j'ai créé mais c'est votre macro qui a été retravaillée par Dan qui a permis cela.
https://forum.excel-pratique.com/viewtopic.php?f=2&t=133400
Je vous remercie pour votre contribution et votre aide.
Sujet marqué comme résolu.
Bonne journée à vous.