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.

15macro-amazon.xlsm (56.86 Ko)

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.

Rechercher des sujets similaires à "application macro feuilles"