Salut François,
J'ai fait ce que tu m'avais dit et c'est VRAIMENT impressionnant.
Bien que cela ne soit pas tout à fait ce que j'attendais c'est très utile et
je compte bien l'utiliser.
J'aimerais avoir qq infos supplémentaires.
Si je rajoute un mot est-ce moi qui dois le transcrire à l'envers où
y-a-t-il une commande de macro à activer ?
Jacques
Bonsoir Jacques,
Si tu souhaites rajouter un mot :
- remplace la macro1() par macro2() ci-dessous,
[cette macro ne doit comporter aucune ligne coupée, montrée en rouge!]
- ajoute ton mot dans la feuille qui va bien (celle dont le nom est la
première lettre du mot),
- relance la macro2
Cette version :
- efface les feuilles dont le nom est numérique
- trie les mots dans les feuilles alphanumériques
- efface les éventuels mots en doublons
- trie les mots selon leur longueur et crée les feuilles si nécessaire
- trie les feuilles selon leur nom (d'où 02 pour les mots de 2 lettres).
Si tu souhaites un autre format d'entrée ou de sortie, il te faudrait
indiquer un exemple suffisamment explicite ... et rien n'est impossible :o)
@+
FxM
Sub Macro2()
Const Cell_Depart As String = "A1"
For Each sht In Sheets
If IsNumeric(sht.Name) Then
Application.DisplayAlerts = False
sht.Delete
Application.DisplayAlerts = True
Else
sht.Activate
ActiveSheet.Range("A1").Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending,
Header:=xlGuess, OrderCustom:=1, MatchCase:úlse,
Orientation:=xlTopToBottom
J = 0
Col = Range(Cell_Depart).Column
Set Fin = Range(Cell_Depart).End(xlDown)(2)
On Error Resume Next
Do
I = J + 1
J = Range(Cells(I, 1), Fin).ColumnDifferences(Cells(I, 1))(0).Row
If J > I Then Range(Cells(I + 1, 1), Cells(J, 1)).ClearContents
Loop Until Err
'Stop
ActiveSheet.Range("A1:A" & I).Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending,
Header:=xlGuess, OrderCustom:=1, MatchCase:úlse,
Orientation:=xlTopToBottom
End If
Next sht
For Each sht In Sheets
sht.Activate
For a = 1 To sht.Range("A65536").End(xlUp).Row
lg = Len(sht.Cells(a, 1).Text)
If lg <> 0 Then
lg = Format(Len(sht.Cells(a, 1).Text), "00")
On Error Resume Next
lst = Sheets("lg=" & lg).Range("A65536").End(xlUp).Row + 1
kk = Err.Number
If Err.Number > 0 Then
On Error GoTo 0
new_sheet = Sheets.Add(After:=Worksheets(Worksheets.Count)).Name
Sheets(new_sheet).Name = "lg=" & Format(lg, "00")
End If
On Error GoTo 0
Err.Clear
DoEvents
lst = Sheets("lg=" & Format(lg,
"00")).Range("A65536").End(xlUp).Row + 1
Sheets("lg=" & Format(lg, "00")).Cells(lst, 1) = sht.Cells(a, 1).Text
End If
Next a
Next sht
For Each sht In Sheets
sht.Name = Application.Substitute(sht.Name, "lg=", "")
Next sht
For Each sht In Sheets
sht.Activate
If IsNumeric(sht.Name) Then
deb = 2: Fin = sht.Range("A65536").End(xlUp).Row
For a = deb To Fin
sht.Cells(a, 2) = StrReverse(sht.Cells(a, 1))
Next a
sht.Range("A1:B" & Fin).Select
Selection.Sort Key1:=Range("B1"), Order1:=xlAscending,
Header:=xlGuess, OrderCustom:=1, MatchCase:úlse,
Orientation:=xlTopToBottom
Range("A1").Select
End If
Next sht
For Each x In ActiveWorkbook.Sheets
For I = 2 To ActiveWorkbook.Sheets.Count
If Sheets(I - 1).Name > Sheets(I).Name Then
Sheets(I - 1).Move After:=Sheets(I)
End If
Next I
Next x
End Sub
Salut François,
J'ai fait ce que tu m'avais dit et c'est VRAIMENT impressionnant.
Bien que cela ne soit pas tout à fait ce que j'attendais c'est très utile et
je compte bien l'utiliser.
J'aimerais avoir qq infos supplémentaires.
Si je rajoute un mot est-ce moi qui dois le transcrire à l'envers où
y-a-t-il une commande de macro à activer ?
Jacques
Bonsoir Jacques,
Si tu souhaites rajouter un mot :
- remplace la macro1() par macro2() ci-dessous,
[cette macro ne doit comporter aucune ligne coupée, montrée en rouge!]
- ajoute ton mot dans la feuille qui va bien (celle dont le nom est la
première lettre du mot),
- relance la macro2
Cette version :
- efface les feuilles dont le nom est numérique
- trie les mots dans les feuilles alphanumériques
- efface les éventuels mots en doublons
- trie les mots selon leur longueur et crée les feuilles si nécessaire
- trie les feuilles selon leur nom (d'où 02 pour les mots de 2 lettres).
Si tu souhaites un autre format d'entrée ou de sortie, il te faudrait
indiquer un exemple suffisamment explicite ... et rien n'est impossible :o)
@+
FxM
Sub Macro2()
Const Cell_Depart As String = "A1"
For Each sht In Sheets
If IsNumeric(sht.Name) Then
Application.DisplayAlerts = False
sht.Delete
Application.DisplayAlerts = True
Else
sht.Activate
ActiveSheet.Range("A1").Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending,
Header:=xlGuess, OrderCustom:=1, MatchCase:úlse,
Orientation:=xlTopToBottom
J = 0
Col = Range(Cell_Depart).Column
Set Fin = Range(Cell_Depart).End(xlDown)(2)
On Error Resume Next
Do
I = J + 1
J = Range(Cells(I, 1), Fin).ColumnDifferences(Cells(I, 1))(0).Row
If J > I Then Range(Cells(I + 1, 1), Cells(J, 1)).ClearContents
Loop Until Err
'Stop
ActiveSheet.Range("A1:A" & I).Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending,
Header:=xlGuess, OrderCustom:=1, MatchCase:úlse,
Orientation:=xlTopToBottom
End If
Next sht
For Each sht In Sheets
sht.Activate
For a = 1 To sht.Range("A65536").End(xlUp).Row
lg = Len(sht.Cells(a, 1).Text)
If lg <> 0 Then
lg = Format(Len(sht.Cells(a, 1).Text), "00")
On Error Resume Next
lst = Sheets("lg=" & lg).Range("A65536").End(xlUp).Row + 1
kk = Err.Number
If Err.Number > 0 Then
On Error GoTo 0
new_sheet = Sheets.Add(After:=Worksheets(Worksheets.Count)).Name
Sheets(new_sheet).Name = "lg=" & Format(lg, "00")
End If
On Error GoTo 0
Err.Clear
DoEvents
lst = Sheets("lg=" & Format(lg,
"00")).Range("A65536").End(xlUp).Row + 1
Sheets("lg=" & Format(lg, "00")).Cells(lst, 1) = sht.Cells(a, 1).Text
End If
Next a
Next sht
For Each sht In Sheets
sht.Name = Application.Substitute(sht.Name, "lg=", "")
Next sht
For Each sht In Sheets
sht.Activate
If IsNumeric(sht.Name) Then
deb = 2: Fin = sht.Range("A65536").End(xlUp).Row
For a = deb To Fin
sht.Cells(a, 2) = StrReverse(sht.Cells(a, 1))
Next a
sht.Range("A1:B" & Fin).Select
Selection.Sort Key1:=Range("B1"), Order1:=xlAscending,
Header:=xlGuess, OrderCustom:=1, MatchCase:úlse,
Orientation:=xlTopToBottom
Range("A1").Select
End If
Next sht
For Each x In ActiveWorkbook.Sheets
For I = 2 To ActiveWorkbook.Sheets.Count
If Sheets(I - 1).Name > Sheets(I).Name Then
Sheets(I - 1).Move After:=Sheets(I)
End If
Next I
Next x
End Sub
Salut François,
J'ai fait ce que tu m'avais dit et c'est VRAIMENT impressionnant.
Bien que cela ne soit pas tout à fait ce que j'attendais c'est très utile et
je compte bien l'utiliser.
J'aimerais avoir qq infos supplémentaires.
Si je rajoute un mot est-ce moi qui dois le transcrire à l'envers où
y-a-t-il une commande de macro à activer ?
Jacques
Bonsoir Jacques,
Si tu souhaites rajouter un mot :
- remplace la macro1() par macro2() ci-dessous,
[cette macro ne doit comporter aucune ligne coupée, montrée en rouge!]
- ajoute ton mot dans la feuille qui va bien (celle dont le nom est la
première lettre du mot),
- relance la macro2
Cette version :
- efface les feuilles dont le nom est numérique
- trie les mots dans les feuilles alphanumériques
- efface les éventuels mots en doublons
- trie les mots selon leur longueur et crée les feuilles si nécessaire
- trie les feuilles selon leur nom (d'où 02 pour les mots de 2 lettres).
Si tu souhaites un autre format d'entrée ou de sortie, il te faudrait
indiquer un exemple suffisamment explicite ... et rien n'est impossible :o)
@+
FxM
Sub Macro2()
Const Cell_Depart As String = "A1"
For Each sht In Sheets
If IsNumeric(sht.Name) Then
Application.DisplayAlerts = False
sht.Delete
Application.DisplayAlerts = True
Else
sht.Activate
ActiveSheet.Range("A1").Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending,
Header:=xlGuess, OrderCustom:=1, MatchCase:úlse,
Orientation:=xlTopToBottom
J = 0
Col = Range(Cell_Depart).Column
Set Fin = Range(Cell_Depart).End(xlDown)(2)
On Error Resume Next
Do
I = J + 1
J = Range(Cells(I, 1), Fin).ColumnDifferences(Cells(I, 1))(0).Row
If J > I Then Range(Cells(I + 1, 1), Cells(J, 1)).ClearContents
Loop Until Err
'Stop
ActiveSheet.Range("A1:A" & I).Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending,
Header:=xlGuess, OrderCustom:=1, MatchCase:úlse,
Orientation:=xlTopToBottom
End If
Next sht
For Each sht In Sheets
sht.Activate
For a = 1 To sht.Range("A65536").End(xlUp).Row
lg = Len(sht.Cells(a, 1).Text)
If lg <> 0 Then
lg = Format(Len(sht.Cells(a, 1).Text), "00")
On Error Resume Next
lst = Sheets("lg=" & lg).Range("A65536").End(xlUp).Row + 1
kk = Err.Number
If Err.Number > 0 Then
On Error GoTo 0
new_sheet = Sheets.Add(After:=Worksheets(Worksheets.Count)).Name
Sheets(new_sheet).Name = "lg=" & Format(lg, "00")
End If
On Error GoTo 0
Err.Clear
DoEvents
lst = Sheets("lg=" & Format(lg,
"00")).Range("A65536").End(xlUp).Row + 1
Sheets("lg=" & Format(lg, "00")).Cells(lst, 1) = sht.Cells(a, 1).Text
End If
Next a
Next sht
For Each sht In Sheets
sht.Name = Application.Substitute(sht.Name, "lg=", "")
Next sht
For Each sht In Sheets
sht.Activate
If IsNumeric(sht.Name) Then
deb = 2: Fin = sht.Range("A65536").End(xlUp).Row
For a = deb To Fin
sht.Cells(a, 2) = StrReverse(sht.Cells(a, 1))
Next a
sht.Range("A1:B" & Fin).Select
Selection.Sort Key1:=Range("B1"), Order1:=xlAscending,
Header:=xlGuess, OrderCustom:=1, MatchCase:úlse,
Orientation:=xlTopToBottom
Range("A1").Select
End If
Next sht
For Each x In ActiveWorkbook.Sheets
For I = 2 To ActiveWorkbook.Sheets.Count
If Sheets(I - 1).Name > Sheets(I).Name Then
Sheets(I - 1).Move After:=Sheets(I)
End If
Next I
Next x
End Sub
--
A tous et toutes je souhaite une agréable journée
A+
JacquesSalut François,
J'ai fait ce que tu m'avais dit et c'est VRAIMENT impressionnant.
Bien que cela ne soit pas tout à fait ce que j'attendais c'est très utile et
je compte bien l'utiliser.
J'aimerais avoir qq infos supplémentaires.
Si je rajoute un mot est-ce moi qui dois le transcrire à l'envers où
y-a-t-il une commande de macro à activer ?
Jacques
Bonsoir Jacques,
Si tu souhaites rajouter un mot :
- remplace la macro1() par macro2() ci-dessous,
[cette macro ne doit comporter aucune ligne coupée, montrée en rouge!]
- ajoute ton mot dans la feuille qui va bien (celle dont le nom est la
première lettre du mot),
- relance la macro2
Cette version :
- efface les feuilles dont le nom est numérique
- trie les mots dans les feuilles alphanumériques
- efface les éventuels mots en doublons
- trie les mots selon leur longueur et crée les feuilles si nécessaire
- trie les feuilles selon leur nom (d'où 02 pour les mots de 2 lettres).
Si tu souhaites un autre format d'entrée ou de sortie, il te faudrait
indiquer un exemple suffisamment explicite ... et rien n'est impossible :o)
@+
FxM
Sub Macro2()
Const Cell_Depart As String = "A1"
For Each sht In Sheets
If IsNumeric(sht.Name) Then
Application.DisplayAlerts = False
sht.Delete
Application.DisplayAlerts = True
Else
sht.Activate
ActiveSheet.Range("A1").Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending,
Header:=xlGuess, OrderCustom:=1, MatchCase:úlse,
Orientation:=xlTopToBottom
J = 0
Col = Range(Cell_Depart).Column
Set Fin = Range(Cell_Depart).End(xlDown)(2)
On Error Resume Next
Do
I = J + 1
J = Range(Cells(I, 1), Fin).ColumnDifferences(Cells(I, 1))(0).Row
If J > I Then Range(Cells(I + 1, 1), Cells(J, 1)).ClearContents
Loop Until Err
'Stop
ActiveSheet.Range("A1:A" & I).Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending,
Header:=xlGuess, OrderCustom:=1, MatchCase:úlse,
Orientation:=xlTopToBottom
End If
Next sht
For Each sht In Sheets
sht.Activate
For a = 1 To sht.Range("A65536").End(xlUp).Row
lg = Len(sht.Cells(a, 1).Text)
If lg <> 0 Then
lg = Format(Len(sht.Cells(a, 1).Text), "00")
On Error Resume Next
lst = Sheets("lg=" & lg).Range("A65536").End(xlUp).Row + 1
kk = Err.Number
If Err.Number > 0 Then
On Error GoTo 0
new_sheet = Sheets.Add(After:=Worksheets(Worksheets.Count)).Name
Sheets(new_sheet).Name = "lg=" & Format(lg, "00")
End If
On Error GoTo 0
Err.Clear
DoEvents
lst = Sheets("lg=" & Format(lg,
"00")).Range("A65536").End(xlUp).Row + 1
Sheets("lg=" & Format(lg, "00")).Cells(lst, 1) = sht.Cells(a, 1).Text
End If
Next a
Next sht
For Each sht In Sheets
sht.Name = Application.Substitute(sht.Name, "lg=", "")
Next sht
For Each sht In Sheets
sht.Activate
If IsNumeric(sht.Name) Then
deb = 2: Fin = sht.Range("A65536").End(xlUp).Row
For a = deb To Fin
sht.Cells(a, 2) = StrReverse(sht.Cells(a, 1))
Next a
sht.Range("A1:B" & Fin).Select
Selection.Sort Key1:=Range("B1"), Order1:=xlAscending,
Header:=xlGuess, OrderCustom:=1, MatchCase:úlse,
Orientation:=xlTopToBottom
Range("A1").Select
End If
Next sht
For Each x In ActiveWorkbook.Sheets
For I = 2 To ActiveWorkbook.Sheets.Count
If Sheets(I - 1).Name > Sheets(I).Name Then
Sheets(I - 1).Move After:=Sheets(I)
End If
Next I
Next x
End Sub
Salut FxM
La macro que tu viens de me fournir, je vais la tester pendant le WE et
suivant les résultats tu auras une réponse dès Lundi
Quelque soit le résultat je te dis encore un grand MERCI pour avoir eu la
patience de m'écouter (où plutot me lire) et avoir fait ce que tu as pu pour
me venir en aide. Si toutefois il y a eu d'autres personnes qui ont
participer à cet échange je te charge de leur transmettre aussi mes
remerciements.
PS : Mes petits enfants préfèrent que je me fasse appelé ''Papy Guadeloupe''
au lieu de Jacques de Guadeloupe alors je vais leur faire plasir et
dorénavant c'est Papy Guadeloupe qui sera mon pseudo
Bonne journée à tous
A+
Jacques dit Papy Guadeloupe
--
A tous et toutes je souhaite une agréable journée
A+
Jacques
Salut François,
J'ai fait ce que tu m'avais dit et c'est VRAIMENT impressionnant.
Bien que cela ne soit pas tout à fait ce que j'attendais c'est très utile et
je compte bien l'utiliser.
J'aimerais avoir qq infos supplémentaires.
Si je rajoute un mot est-ce moi qui dois le transcrire à l'envers où
y-a-t-il une commande de macro à activer ?
Jacques
Bonsoir Jacques,
Si tu souhaites rajouter un mot :
- remplace la macro1() par macro2() ci-dessous,
[cette macro ne doit comporter aucune ligne coupée, montrée en rouge!]
- ajoute ton mot dans la feuille qui va bien (celle dont le nom est la
première lettre du mot),
- relance la macro2
Cette version :
- efface les feuilles dont le nom est numérique
- trie les mots dans les feuilles alphanumériques
- efface les éventuels mots en doublons
- trie les mots selon leur longueur et crée les feuilles si nécessaire
- trie les feuilles selon leur nom (d'où 02 pour les mots de 2 lettres).
Si tu souhaites un autre format d'entrée ou de sortie, il te faudrait
indiquer un exemple suffisamment explicite ... et rien n'est impossible :o)
@+
FxM
Sub Macro2()
Const Cell_Depart As String = "A1"
For Each sht In Sheets
If IsNumeric(sht.Name) Then
Application.DisplayAlerts = False
sht.Delete
Application.DisplayAlerts = True
Else
sht.Activate
ActiveSheet.Range("A1").Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending,
Header:=xlGuess, OrderCustom:=1, MatchCase:úlse,
Orientation:=xlTopToBottom
J = 0
Col = Range(Cell_Depart).Column
Set Fin = Range(Cell_Depart).End(xlDown)(2)
On Error Resume Next
Do
I = J + 1
J = Range(Cells(I, 1), Fin).ColumnDifferences(Cells(I, 1))(0).Row
If J > I Then Range(Cells(I + 1, 1), Cells(J, 1)).ClearContents
Loop Until Err
'Stop
ActiveSheet.Range("A1:A" & I).Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending,
Header:=xlGuess, OrderCustom:=1, MatchCase:úlse,
Orientation:=xlTopToBottom
End If
Next sht
For Each sht In Sheets
sht.Activate
For a = 1 To sht.Range("A65536").End(xlUp).Row
lg = Len(sht.Cells(a, 1).Text)
If lg <> 0 Then
lg = Format(Len(sht.Cells(a, 1).Text), "00")
On Error Resume Next
lst = Sheets("lg=" & lg).Range("A65536").End(xlUp).Row + 1
kk = Err.Number
If Err.Number > 0 Then
On Error GoTo 0
new_sheet = Sheets.Add(After:=Worksheets(Worksheets.Count)).Name
Sheets(new_sheet).Name = "lg=" & Format(lg, "00")
End If
On Error GoTo 0
Err.Clear
DoEvents
lst = Sheets("lg=" & Format(lg,
"00")).Range("A65536").End(xlUp).Row + 1
Sheets("lg=" & Format(lg, "00")).Cells(lst, 1) = sht.Cells(a, 1).Text
End If
Next a
Next sht
For Each sht In Sheets
sht.Name = Application.Substitute(sht.Name, "lg=", "")
Next sht
For Each sht In Sheets
sht.Activate
If IsNumeric(sht.Name) Then
deb = 2: Fin = sht.Range("A65536").End(xlUp).Row
For a = deb To Fin
sht.Cells(a, 2) = StrReverse(sht.Cells(a, 1))
Next a
sht.Range("A1:B" & Fin).Select
Selection.Sort Key1:=Range("B1"), Order1:=xlAscending,
Header:=xlGuess, OrderCustom:=1, MatchCase:úlse,
Orientation:=xlTopToBottom
Range("A1").Select
End If
Next sht
For Each x In ActiveWorkbook.Sheets
For I = 2 To ActiveWorkbook.Sheets.Count
If Sheets(I - 1).Name > Sheets(I).Name Then
Sheets(I - 1).Move After:=Sheets(I)
End If
Next I
Next x
End Sub
Salut FxM
La macro que tu viens de me fournir, je vais la tester pendant le WE et
suivant les résultats tu auras une réponse dès Lundi
Quelque soit le résultat je te dis encore un grand MERCI pour avoir eu la
patience de m'écouter (où plutot me lire) et avoir fait ce que tu as pu pour
me venir en aide. Si toutefois il y a eu d'autres personnes qui ont
participer à cet échange je te charge de leur transmettre aussi mes
remerciements.
PS : Mes petits enfants préfèrent que je me fasse appelé ''Papy Guadeloupe''
au lieu de Jacques de Guadeloupe alors je vais leur faire plasir et
dorénavant c'est Papy Guadeloupe qui sera mon pseudo
Bonne journée à tous
A+
Jacques dit Papy Guadeloupe
--
A tous et toutes je souhaite une agréable journée
A+
JacquesSalut François,
J'ai fait ce que tu m'avais dit et c'est VRAIMENT impressionnant.
Bien que cela ne soit pas tout à fait ce que j'attendais c'est très utile et
je compte bien l'utiliser.
J'aimerais avoir qq infos supplémentaires.
Si je rajoute un mot est-ce moi qui dois le transcrire à l'envers où
y-a-t-il une commande de macro à activer ?
Jacques
Bonsoir Jacques,
Si tu souhaites rajouter un mot :
- remplace la macro1() par macro2() ci-dessous,
[cette macro ne doit comporter aucune ligne coupée, montrée en rouge!]
- ajoute ton mot dans la feuille qui va bien (celle dont le nom est la
première lettre du mot),
- relance la macro2
Cette version :
- efface les feuilles dont le nom est numérique
- trie les mots dans les feuilles alphanumériques
- efface les éventuels mots en doublons
- trie les mots selon leur longueur et crée les feuilles si nécessaire
- trie les feuilles selon leur nom (d'où 02 pour les mots de 2 lettres).
Si tu souhaites un autre format d'entrée ou de sortie, il te faudrait
indiquer un exemple suffisamment explicite ... et rien n'est impossible :o)
@+
FxM
Sub Macro2()
Const Cell_Depart As String = "A1"
For Each sht In Sheets
If IsNumeric(sht.Name) Then
Application.DisplayAlerts = False
sht.Delete
Application.DisplayAlerts = True
Else
sht.Activate
ActiveSheet.Range("A1").Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending,
Header:=xlGuess, OrderCustom:=1, MatchCase:úlse,
Orientation:=xlTopToBottom
J = 0
Col = Range(Cell_Depart).Column
Set Fin = Range(Cell_Depart).End(xlDown)(2)
On Error Resume Next
Do
I = J + 1
J = Range(Cells(I, 1), Fin).ColumnDifferences(Cells(I, 1))(0).Row
If J > I Then Range(Cells(I + 1, 1), Cells(J, 1)).ClearContents
Loop Until Err
'Stop
ActiveSheet.Range("A1:A" & I).Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending,
Header:=xlGuess, OrderCustom:=1, MatchCase:úlse,
Orientation:=xlTopToBottom
End If
Next sht
For Each sht In Sheets
sht.Activate
For a = 1 To sht.Range("A65536").End(xlUp).Row
lg = Len(sht.Cells(a, 1).Text)
If lg <> 0 Then
lg = Format(Len(sht.Cells(a, 1).Text), "00")
On Error Resume Next
lst = Sheets("lg=" & lg).Range("A65536").End(xlUp).Row + 1
kk = Err.Number
If Err.Number > 0 Then
On Error GoTo 0
new_sheet = Sheets.Add(After:=Worksheets(Worksheets.Count)).Name
Sheets(new_sheet).Name = "lg=" & Format(lg, "00")
End If
On Error GoTo 0
Err.Clear
DoEvents
lst = Sheets("lg=" & Format(lg,
"00")).Range("A65536").End(xlUp).Row + 1
Sheets("lg=" & Format(lg, "00")).Cells(lst, 1) = sht.Cells(a, 1).Text
End If
Next a
Next sht
For Each sht In Sheets
sht.Name = Application.Substitute(sht.Name, "lg=", "")
Next sht
For Each sht In Sheets
sht.Activate
If IsNumeric(sht.Name) Then
deb = 2: Fin = sht.Range("A65536").End(xlUp).Row
For a = deb To Fin
sht.Cells(a, 2) = StrReverse(sht.Cells(a, 1))
Next a
sht.Range("A1:B" & Fin).Select
Selection.Sort Key1:=Range("B1"), Order1:=xlAscending,
Header:=xlGuess, OrderCustom:=1, MatchCase:úlse,
Orientation:=xlTopToBottom
Range("A1").Select
End If
Next sht
For Each x In ActiveWorkbook.Sheets
For I = 2 To ActiveWorkbook.Sheets.Count
If Sheets(I - 1).Name > Sheets(I).Name Then
Sheets(I - 1).Move After:=Sheets(I)
End If
Next I
Next x
End Sub
Salut FxM
La macro que tu viens de me fournir, je vais la tester pendant le WE et
suivant les résultats tu auras une réponse dès Lundi
Quelque soit le résultat je te dis encore un grand MERCI pour avoir eu la
patience de m'écouter (où plutot me lire) et avoir fait ce que tu as pu pour
me venir en aide. Si toutefois il y a eu d'autres personnes qui ont
participer à cet échange je te charge de leur transmettre aussi mes
remerciements.
PS : Mes petits enfants préfèrent que je me fasse appelé ''Papy Guadeloupe''
au lieu de Jacques de Guadeloupe alors je vais leur faire plasir et
dorénavant c'est Papy Guadeloupe qui sera mon pseudo
Bonne journée à tous
A+
Jacques dit Papy Guadeloupe
Salut FxM
Comme promis j'ai testé la macro que tu m'as expédiée.
Je dois, hélas, déplorer un non fonctionnement. Je m'explique :
Après avoir tapé toute la macro et corriger mes erreurs de frappe
j'obtiens la fenêtre suivante : "Erreur d'éxécution '1004': Erreur définie
par l'application ou par l'objet" et la ligne suivante est surlignée en jaune
:
lst = Sheets("lg=" & Format(lg, "00")).Range("A65536"=.End(xlUp).Row + 1
Alors j'ai testé également la 'mini macro' que m'avait adressé Modeste. Cela
fonction presque normalement. Le seul regrets c'est que les mots sont écrits
à l'envers et cela ne convient pas vraiment pour un dictionnaire de mots
croisés
Exemple : EXCEL est écrit LECXE. Je veux pouvoir le classé dans les ''L''
mais il doit toujours être écrit dans le sens normal de lecture.
A part cela tout va bien et je souhaite à toute l'équipe une agréable
journée de la part de
PAPY GUADELOUPE
Après avoir tapé toute la macro
tapé ?? Un copier-coller marche aussi :o)
lst = Sheets("lg=" & Format(lg, "00")).Range("A65536"=.End(xlUp).Row + 1
Vérifies que tu aies bien Range("A65536").End (pas de signe =).
Salut FxM
Comme promis j'ai testé la macro que tu m'as expédiée.
Je dois, hélas, déplorer un non fonctionnement. Je m'explique :
Après avoir tapé toute la macro et corriger mes erreurs de frappe
j'obtiens la fenêtre suivante : "Erreur d'éxécution '1004': Erreur définie
par l'application ou par l'objet" et la ligne suivante est surlignée en jaune
:
lst = Sheets("lg=" & Format(lg, "00")).Range("A65536"=.End(xlUp).Row + 1
Alors j'ai testé également la 'mini macro' que m'avait adressé Modeste. Cela
fonction presque normalement. Le seul regrets c'est que les mots sont écrits
à l'envers et cela ne convient pas vraiment pour un dictionnaire de mots
croisés
Exemple : EXCEL est écrit LECXE. Je veux pouvoir le classé dans les ''L''
mais il doit toujours être écrit dans le sens normal de lecture.
A part cela tout va bien et je souhaite à toute l'équipe une agréable
journée de la part de
PAPY GUADELOUPE
Après avoir tapé toute la macro
tapé ?? Un copier-coller marche aussi :o)
lst = Sheets("lg=" & Format(lg, "00")).Range("A65536"=.End(xlUp).Row + 1
Vérifies que tu aies bien Range("A65536").End (pas de signe =).
Salut FxM
Comme promis j'ai testé la macro que tu m'as expédiée.
Je dois, hélas, déplorer un non fonctionnement. Je m'explique :
Après avoir tapé toute la macro et corriger mes erreurs de frappe
j'obtiens la fenêtre suivante : "Erreur d'éxécution '1004': Erreur définie
par l'application ou par l'objet" et la ligne suivante est surlignée en jaune
:
lst = Sheets("lg=" & Format(lg, "00")).Range("A65536"=.End(xlUp).Row + 1
Alors j'ai testé également la 'mini macro' que m'avait adressé Modeste. Cela
fonction presque normalement. Le seul regrets c'est que les mots sont écrits
à l'envers et cela ne convient pas vraiment pour un dictionnaire de mots
croisés
Exemple : EXCEL est écrit LECXE. Je veux pouvoir le classé dans les ''L''
mais il doit toujours être écrit dans le sens normal de lecture.
A part cela tout va bien et je souhaite à toute l'équipe une agréable
journée de la part de
PAPY GUADELOUPE
Après avoir tapé toute la macro
tapé ?? Un copier-coller marche aussi :o)
lst = Sheets("lg=" & Format(lg, "00")).Range("A65536"=.End(xlUp).Row + 1
Vérifies que tu aies bien Range("A65536").End (pas de signe =).
