VBA - Fusionner plusieurs macros

Le 10/12/2019 à 10:27

Bonjour à tous,

Pourriez-vous m'aider à fusionner plusieurs macros s'il vous plaît ?

Explications :

Macros :

mise_en_page_csv_pays - utilisée sur les feuilles : AMZN UK / AMZN DE / AMZN FR / AMZN IT / AMZN ES

mise_en_page_csv_eu - utilisée sur la feuille : EU

et après avoir utilisé les deux macro ci-dessus j'utilise la macro :

country_formula sur les feuilles : AMZN UK / AMZN DE / AMZN FR / AMZN IT / AMZN ES

Pour les feuilles AMZN UK / AMZN DE / AMZN FR / AMZN IT / AMZN ES, j'ai besoin de faire une mise en forme qui supprime les 6 premières lignes et paramètre les nombres dans le bon format avec les bons séparateurs. Puis j'ai besoin d'insérer 2 colonnes avec des formules à gauche de la colonne [Ventes de produits].

1ère colonne [Names] avec les noms des clients

2ème colonne [Country] pays de livraison

Je n'ai pas su fusionner les codes mise_en_page_csv_pays & country_formula qui font la même chose si vous regardez (sauf la mise en forme qui est faite par la macro mise_en_page_csv_pays)

Après cela, ce serait bien de fusionner toutes ces macros en une avec application sur différentes feuilles

Sur les feuilles : AMZN UK / AMZN DE / AMZN FR / AMZN IT / AMZN ES les macros mise_en_page_csv_pays & country_formula

Sur la feuille : EU la macro mise_en_page_csv_eu

J'espère avoir bien expliqué ma demande et que quelqu'un pourra m'aider avec cela.

Je vous joint les codes ci-dessous :

- mise_en_page_csv_pays

Sub mise_en_page_csv_pays()
'
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
'Range("N:V")
    For col = Asc("N") To Asc("V")
        num (col - 64)
    Next
Application.ScreenUpdating = True

End Sub
Sub num(col%)
    With Columns(col)
        .Replace What:="=", Replacement:="""", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        .Replace What:=".", Replacement:=",", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        .TextToColumns Destination:=Cells(1, col), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 1), TrailingMinusNumbers:=True
    End With
End Sub

- mise_en_page_csv_eu

Sub mise_en_page_csv_eu()
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

   'Range("R:W,AO:AP")
    For col = Asc("R") To Asc("W")
        num (col - 64)
    Next
    For col = Asc("O") To Asc("P")
        num (col - 64 + 26)
    Next
Application.ScreenUpdating = True

End Sub

Sub num(col%)
    With Columns(col)
        .Replace What:="=", Replacement:="""", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        .Replace What:=".", Replacement:=",", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        .TextToColumns Destination:=Cells(1, col), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 1), TrailingMinusNumbers:=True
    End With
End Sub

- country_formula

Sub country_formula()
Columns("M:M").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("M1").Select
    ActiveCell.FormulaR1C1 = "Country"
Dim DL As Integer
DL = Cells(Application.Rows.Count, "A").End(xlUp).Row
Range("M2:M" & DL).FormulaR1C1 = "=IFERROR(VLOOKUP(RC4,EU!C1:C32,32,FALSE),"""")"
Range("M2").AutoFill Destination:=Range("M2:M" & DL), Type:=xlFillDefault
End Sub

Bien sûr que je vous joint un fichier avec un exemple des informations et macros à utiliser.

Je vous remercie de toute l'attention que vous porterez à ma demande.

63excel-pratique.xlsm (58.70 Ko)
Le 10/12/2019 à 12:51

Bonjour

une question : Est-ce que vous pouvez avoir d'autres feuilles AMZN que celles qui sont dans votre fichier ?

Cordialement

Le 10/12/2019 à 12:59

Bonjour Dan,

Merci d'être passé sur le sujet, j'espère que vous allez bien.

Pour l'instant, il n'y a que ces marketplaces. Mais je pense que dans quelques mois, il y en aura peut être 1 ou 2 de plus mais le nom des feuilles sera pareil AMZN et 2 lettres ISO du pays.

Voilà un code qui m'avait été proposé par un membre du forum.

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
Le 10/12/2019 à 13:18

Re

La solution était proche mais essayez plutot ceci :

Sub mise_en_page_csv_pays()
Dim onglet()
Dim DL As Integer

Application.ScreenUpdating = False

onglet = Array("AMZN UK", "AMZN DE", "AMZN FR", "AMZN IT", "AMZN ES")

For i = 0 To UBound(onglet)

    With Sheets(onglet(i))
        .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").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
        .Columns("M:M").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
        .Range("M1").FormulaR1C1 = "Names"

        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 With
    For col = Asc("N") To Asc("V")
        num (col - 64)
    Next

Next i

Application.ScreenUpdating = True

End Sub

Cordialement

Le 10/12/2019 à 14:26
Dan a écrit :

Re

La solution était proche mais essayez plutot ceci :

Sub mise_en_page_csv_pays()
Dim onglet()
Dim DL As Integer

Application.ScreenUpdating = False

onglet = Array("AMZN UK", "AMZN DE", "AMZN FR", "AMZN IT", "AMZN ES")

For i = 0 To UBound(onglet)

    With Sheets(onglet(i))
        .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").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
        .Columns("M:M").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
        .Range("M1").FormulaR1C1 = "Names"

        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 With
    For col = Asc("N") To Asc("V")
        num (col - 64)
    Next

Next i

Application.ScreenUpdating = True

End Sub

Cordialement

Dan,

Merci beaucoup pour votre contribution en effet cela fonctionne à merveille. Voici le code que j'ai utilisé :

Pourriez vous me dire s'il y a quelque chose qui pourrait être simplifié ?

Sub mise_en_page_csv_pays()
Dim onglet()
Dim DL As Integer

Application.ScreenUpdating = False

onglet = Array("AMZN UK", "AMZN DE", "AMZN FR", "AMZN IT", "AMZN ES")

For i = 0 To UBound(onglet)

    With Sheets(onglet(i))
        .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").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
        .Columns("M:M").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
        .Range("M1").FormulaR1C1 = "Names"

        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 With
    For col = Asc("N") To Asc("V")
        num (col - 64)
    Next

Next i

Application.ScreenUpdating = True

End Sub
Sub num(col%)
    With Columns(col)
        .Replace What:="=", Replacement:="""", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        .Replace What:=".", Replacement:=",", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    End With
End Sub

Cela résous le problème de l'application de la macro : mise_en_page_csv_pays sur plusieurs feuilles d'un seul clic (et c'est génial, je vous remercie pour votre aide) mais j'ai toujours 3 macros à utiliser.

Est-il possible de fusionner ces 3 macros en 1 macro à votre avis ?

Je vous remercie de toute l'attention que vous porterez à ma demande.

Le 11/12/2019 à 12:56

Bonjour

Est-il possible de fusionner ces 3 macros en 1 macro à votre avis ?

Oui c'est possible mais je ne vous conseille pas de faire cela.

Il vaut mieux avoir de petite macro qui intèragissent entre elles c'est plus facile dans la compréhension.

Mais si vous le voulez cela peut se faire bien entendu

Cordialement

Le 12/12/2019 à 09:10
Dan a écrit :

Bonjour

Est-il possible de fusionner ces 3 macros en 1 macro à votre avis ?

Oui c'est possible mais je ne vous conseille pas de faire cela.

Il vaut mieux avoir de petite macro qui intèragissent entre elles c'est plus facile dans la compréhension.

Mais si vous le voulez cela peut se faire bien entendu

Cordialement

Bonjour Dan,

J'espère que vous allez bien.

Je vais suivre votre conseil et laisser comme tel.

Merci beaucoup pour votre aide.

Sujet résolu.

Bonne journée à vous et bonne fin de semaine.

Rechercher des sujets similaires à "vba fusionner macros"