Appliquer une macro sur tous les onglets d'un classeur

Le 13/12/2017 à 10:52

Bonjour a tous

J'ai crée une macro pour convertir la colonne A d'un onglet (séparateur point virgule) dont voici le code:

Sub Convertir_colonne()

Columns("A:A").Select

Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _

TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _

Semicolon:=True, Comma:=False, 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)), TrailingMinusNumbers:=True

End Sub

J'ai essayé de faire une boucle "for each" afin d'appliquer la macro à tous les onglets mais ça ne fonctionne pas, voila la macro:

Dim ws As Worksheet

For Each ws In Worksheets

Sheets(ws.Name).Cells(1, 1).Select

Selection.TextToColumns Destination:=Sheets(ws.Name).Cells(1, 1), DataType:=xlDelimited, _

TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _

Semicolon:=True, Comma:=False, 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)), TrailingMinusNumbers:=True

Next

End Sub

Merci pour votre aide

Le 13/12/2017 à 11:01

Bonjour,

Utilise la balise code pour inclure du VBA dans le post et améliorer la lecture.

Où cela plante-t-il ? quelle ligne ?

Ajoute

ws.select

Sheets(ws.Name) ... à remplacer par ws tout court !

Le 13/12/2017 à 11:10

Salut Steelson

merci pour ton retour, désolé je suis novice sur le site:

Comment on utilise la balise code ?

merci

Le 13/12/2017 à 11:22
Steelson a écrit :

Bonjour,

Utilise la balise code pour inclure du VBA dans le post et améliorer la lecture.

Où cela plante-t-il ? quelle ligne ?

Ajoute

ws.select

Sheets(ws.Name) ... à remplacer par ws tout court !

Voila mon code corrigé:

Dim ws As Worksheet

  For Each ws In Worksheets

        ws.Cells(1, 1).Select
        Selection.TextToColumns Destination:=ws.Cells(1, 1), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=True, Comma:=False, 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)), TrailingMinusNumbers:=True

        Next
End Sub

Mais un message d'erreur s'affiche (debogage)

Le 13/12/2017 à 11:28

Où cela bogue-t-il ?

Sinon essaye ceci

Dim ws As Worksheet

  For Each ws In Worksheets

        ws.Select

        Selection.TextToColumns Destination:=ws.Cells(1, 1), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=True, Comma:=False, 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)), TrailingMinusNumbers:=True

    Next

comme je n'ai pas le reste du fichier, je navigue "à vue"

Le 13/12/2017 à 11:39
Steelson a écrit :

Où cela bogue-t-il ?

Sinon essaye ceci

Dim ws As Worksheet

  For Each ws In Worksheets

        ws.Select

        Selection.TextToColumns Destination:=ws.Cells(1, 1), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=True, Comma:=False, 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)), TrailingMinusNumbers:=True

    Next

comme je n'ai pas le reste du fichier, je navigue "à vue"

Désolé

ci-joint un fichier test dans lequel il y a la macro qui s'applique à un seul onglet

4toto.xlsm (18.23 Ko)
Le 13/12/2017 à 11:42

proposition

Option Explicit
Sub convertir_colonne()
Dim ws As Worksheet
For Each ws In Worksheets

    ws.Select
    Columns("A:A").Select
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=True, Comma:=False, 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)), TrailingMinusNumbers:=True

Next
End Sub
5toto.xlsm (17.21 Ko)
Le 13/12/2017 à 11:49
Steelson a écrit :

proposition

Option Explicit
Sub convertir_colonne()
Dim ws As Worksheet
For Each ws In Worksheets

    ws.Select
    Columns("A:A").Select
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=True, Comma:=False, 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)), TrailingMinusNumbers:=True

Next
End Sub

Exelent Steelson

ça fonctionne ! Au top

merci beaucoup

Le 13/12/2017 à 11:52

Parfait ! content que cela convienne ... clique sur le cœur si la solution te convient ...

Rechercher des sujets similaires à "appliquer macro tous onglets classeur"