Microsoft 365 Macro excel qui bug

Sub Modif()

Dim fl As Worksheet

'Désactiver le raffraichissement d'écran
Application.ScreenUpdating = False

'Désactiver le Calcul Automatique
Application.Calculation = xlManual



' Travailler sur la feuille Vte, Cai et Bqe
For Each fl In Worksheets

If fl.Name <> "Vte" And fl.Name <> "Cai" And fl.Name <> "Bqe" Then

'Remplacer les points par des virgules pour les colonnes G et H

Columns("G:H").Select
Selection.Replace What:=".", Replacement:=",", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2

'Supprimer colonnes inutiles
.Range("A:A,E:E").Delete

' Déplacer la colonne de "pièce"

Columns("D:D").Select
Application.CutCopyMode = False
Selection.Cut
Columns("B:B").Select
Selection.Insert Shift:=xlToRight

'Supprimer 1ère ligne
.Rows("1:1").Delete

End If


' Travailler sur la feuille Cai et Bqe
If fl.Name <> "Cai" And fl.Name <> "Bqe" Then


' Ne garder que les 4 premiers caractères de la colonne N° pièce (F)


'Réactiver le Calcul Automatique
Application.Calculation = xlAutomatic
'Réactiver le raffraichissement d'écran
Application.ScreenUpdating = True

End Sub

Sub Modif_II()
Dim fl As Worksheet
'Désactiver le raffraichissement d'écran
Application.ScreenUpdating = False
'Désactiver le Calcul Automatique
Application.Calculation = xlManual
' Travailler sur la feuille Vte, Cai et Bqe
For Each fl In Worksheets
If fl.Name <> "Vte" And fl.Name <> "Cai" And fl.Name <> "Bqe" Then
'Remplacer les points par des virgules pour les colonnes G et H
fl.Columns("G:H").Replace What:=".", Replacement:=","
'Supprimer colonnes inutiles
fl.Range("A:A,E:E").Delete
' Déplacer la colonne de "pièce"
fl.Columns("D:D").Cut fl.Columns("B:B") '.Insert Shift:=xlToRight
'Supprimer 1ère ligne
fl.Rows("1:1").Delete
End If
Next
'Réactiver le Calcul Automatique
Application.Calculation = xlAutomatic
'Réactiver le raffraichissement d'écran
Application.ScreenUpdating = True
End Sub

Sub Modif_III()
Const FAT As String = "VteCaiBqe"
Dim ws As Worksheet, Nfo
Nfo = Array(Array(0, 1), Array(4, 9))
Application.ScreenUpdating = False
For Each ws In Worksheets
    If InStr(1, FAT, ws.Name) > 0 Then
        With ws
            .Columns("G:H").Replace What:=".", Replacement:=",", LookAt:=2, SearchOrder:=1
            .Columns(7).TextToColumns Destination:=Range("G1"), DataType:=1
            .Columns(8).TextToColumns Destination:=Range("H1"), DataType:=1
            .Range("A:A,E:E").Delete
            .Columns("D:D").Cut
            .Columns("B:B").Insert Shift:=xlToRight
            Application.CutCopyMode = False
            .Columns("B:B").TextToColumns Destination:=Range("B1"), DataType:=2, FieldInfo:=Nfo
            .[B1] = "N° Pièce"
            .[A1].CurrentRegion.Columns.AutoFit
        End With
    End If
Next
End Sub