Option Explicit
'*******************
Sub TraductionFrance()
'### Déclaration explicite des variables ###
Dim WB As Workbook
Dim WB2 As Workbook
Dim S As Worksheet
Dim R As Range
Dim var As Variant
'--- typage par suffixe $=string &=long ---
Dim A$
Dim i&
'### gestion d'erreur et désactivation écran et alertes ###
On Error GoTo Erreur
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set WB = ActiveWorkbook
'### création d'un nouveau classeur avec 1 seule feuille ###
Set WB2 = Workbooks.Add(xlWBATWorksheet)
'### chaque feuille du classeur source sont copiées dans le nouveau ###
For Each S In WB.Worksheets
S.Copy after:=WB2.Sheets(WB2.Sheets.Count)
Next S
'/// on est sur le nouveau classeur ////
'### supprime la 1ère feuille (initiale) du nouveau classeur ###
WB2.Sheets(1).Delete
'### boucle sur toutes les feuilles ###
For Each S In WB2.Worksheets
Set R = S.UsedRange 'affecte toute la plage de la feuille dans un Range
var = R 'le contenu du range mis en mémoire dans un variant
'--- le variant est comme un tableau bidimensionné ---
'--- on fait une boucle sur toutes ses lignes ---
'--- elle part de 1 et s'incrémente de 2 (Step 2)
For i& = 1 To UBound(var, 1) Step 2
'--- colonne B ---
'--- assigne la valeur du tableau (i&=ligne 2=colonne) ---
'commentaires variables en fonction de i&
A$ = var(i& + 1, 2) 'si i&=1 lit ligne+1, colonne2 = "B2"
If A$ <> "" Then 'si i&=1 si "B2" n'est pas vide
var(i&, 2) = A$ 'on affecte sa valeur a "B1"
var(i& + 1, 2) = "" 'on met à vide "B2"
End If
'--- colonne E ---
A$ = var(i& + 1, 5) 'même principe qu'au dessus
If A$ <> "" Then 'mais avec la colonne 5 "E2"
var(i&, 5) = A$
var(i& + 1, 5) = ""
End If
Next i&
'--- On passe les nouvelles valeurs au Range ---
R = var
'--- on boucle à l'envers sur toutes lignes ---
For i& = UBound(var, 1) To 1 Step -2
S.Rows(i&).Delete 'on élimine les lignes paires
Next i&
Next S
'--- arrange les 2 classeurs pour visualisation---
Windows.Arrange ArrangeStyle:=xlHorizontal
'### pseudo traitement d'erreur car on y passe systématiquement ###
Erreur:
Application.DisplayAlerts = True
Application.ScreenUpdating = True
'--- si erreur, affiche son N°,sa description ---
'--- et la feuille où l'arrêt se produit ---
If Err <> 0 Then MsgBox "Erreur " & Err.Number & vbCrLf & _
Err.Description & vbCrLf & "Arrêt sur la feuille " & S.Name
End Sub
'*******************
