Supression de toutes les macros d'un onglet

jose.carreira

XLDnaute Junior
Bonjour

Comment effacer les macros d’un onglet Excel (par macro) ?

En effet pour un traitement hebdomadaire je récupère un onglet d’un classeur mais il est composé de plusieurs fonctions qui me met mon traitement en défaut.

Merci d’avance
 

MJ13

XLDnaute Barbatruc
Re : Supression de toutes les macros d'un onglet

Bonjour José

J'ai retrouvé un code qui permet de supprimer les macros lors de l'exportation d'une feuille.


Code VBA:
'- le projet à exporter ne doit pas être protégé
'- la librairie Microsoft Visual Basic Extensibility 5.x doit être cochée
Sub copieFeuilleSansModulesNiMacro()
Dim i As Integer
Dim oComposant As VBComponent
Dim sNomModule As String, LigneTitre As String
ThisWorkbook.Sheets("Feuil1").Copy
For Each oComposant In ActiveWorkbook.VBProject.VBComponents
sNomModule = oComposant.Name
If oComposant.Type = vbext_ct_ClassModule Or vbext_ct_StdModule Or vbext_ct_MSForm Then
With oComposant.CodeModule
.DeleteLines 1, .CountOfLines
End With
End If
Next oComposant
End Sub
 

camarchepas

XLDnaute Barbatruc
Re : Supression de toutes les macros d'un onglet

Bonjour Michel, José,

@ Michel joli code en effet, je crois qu'il faut ausi dans les sécurités faire confiance au projet vba ou un truc de la sorte.

Pas forcement nécessaire de supprimer le code ,
tu peux le temps de l'utilisation de ces onglets débrayer les événementiels .

Application.enableevents.false

et lorsque les traitements sont finis ,

application.enableevents.true
 

jose.carreira

XLDnaute Junior
Re : Supression de toutes les macros d'un onglet

Voilà la macro toute entière, (à metre dans un module).
Encore une fois merci de ta participation.

Le principe est de récupérer sur un fichier distant les informations pour les ré-exploité sur un autre fichier, en ne prenant que les informations pertinentes.
Je te détaille le tout.

Ci besoin je reste dispo pour toutes informations complémentaires.

Code:
Option Base 1

Sub Macro_MAJ()

Dim Sh As Worksheet

Dim i As Integer

Dim oComposant As VBComponent
Dim sNomModule As String, LigneTitre As String

Dim Derligne_cible As Integer
Dim Derligne_source As Integer
Dim Onglet_source_existe As Boolean
Dim Filtre_actif As Boolean

Dim Chemin_Fichier_source As String
Dim Fichier_source As String
Dim Fichier_cible As String 'ce fichier
Dim Onglet_cible As String
Dim Onglet_source As String
Dim Ligne_SP As String
Dim Max_SP As String

Dim Tab_correspondance_colonne(72) As Integer

Application.ScreenUpdating = False ' arret affichage

' Efface les N° de Parts
    Range("A4").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.ClearContents
    
'Paramètrage des noms de fichiers
Fichier_cible = "Non_du_fichier_1.xlsm"
Chemin_Fichier_source = "Chemin du fichier source c:\\ ou http://"
Fichier_source = "Non_du_fichier_2.xlsm"
Onglet_cible = "Onglet_du_fichier_1"
Onglet_source = "Onglet_du_fichier_1"

'tableau de correspondance des colonne entre les 2 fichier
' Colonne cible = Colonne source    Lettre colonne cible
Tab_correspondance_colonne(1) = 1           'A
Tab_correspondance_colonne(2) = 2           'B
Tab_correspondance_colonne(3) = 3           'C
Tab_correspondance_colonne(4) = 4           'D
Tab_correspondance_colonne(5) = 5           'E
Tab_correspondance_colonne(6) = 6           'F
Tab_correspondance_colonne(7) = 7           'G
Tab_correspondance_colonne(8) = 8           'H
Tab_correspondance_colonne(9) = 9           'I
Tab_correspondance_colonne(10) = 10         'J
Tab_correspondance_colonne(11) = 11         'K
Tab_correspondance_colonne(12) = 12         'L
Tab_correspondance_colonne(13) = 13         'M
Tab_correspondance_colonne(14) = 14         'N
Tab_correspondance_colonne(15) = 15         'O
Tab_correspondance_colonne(16) = 16         'P
Tab_correspondance_colonne(17) = 17         'Q
Tab_correspondance_colonne(18) = 18         'R
Tab_correspondance_colonne(19) = 19         'S
Tab_correspondance_colonne(20) = 20         'T
Tab_correspondance_colonne(21) = 21         'U
Tab_correspondance_colonne(22) = 22         'V
Tab_correspondance_colonne(23) = 23         'W
Tab_correspondance_colonne(24) = 24         'X
Tab_correspondance_colonne(25) = 25         'Y
Tab_correspondance_colonne(26) = 26         'Z
Tab_correspondance_colonne(27) = 27         'AA
Tab_correspondance_colonne(28) = 28         'AB
Tab_correspondance_colonne(29) = 29         'AC
Tab_correspondance_colonne(30) = 30         'AD
Tab_correspondance_colonne(31) = 31         'AE
Tab_correspondance_colonne(32) = 32         'AF
Tab_correspondance_colonne(33) = 33         'AG
Tab_correspondance_colonne(34) = 34         'AH
Tab_correspondance_colonne(35) = 35         'AI
Tab_correspondance_colonne(36) = 36         'AJ
Tab_correspondance_colonne(37) = 37         'AK
Tab_correspondance_colonne(38) = 38         'AL
Tab_correspondance_colonne(39) = 39         'AM
Tab_correspondance_colonne(40) = 40         'AN
Tab_correspondance_colonne(41) = 41         'AO
Tab_correspondance_colonne(42) = 42         'AP
Tab_correspondance_colonne(43) = 43         'AQ
Tab_correspondance_colonne(44) = 44         'AR
Tab_correspondance_colonne(45) = 45         'AS
Tab_correspondance_colonne(46) = 46         'AT
Tab_correspondance_colonne(47) = 47         'AU
Tab_correspondance_colonne(48) = 48         'AV
Tab_correspondance_colonne(49) = 49         'AW
Tab_correspondance_colonne(50) = 50         'AX
Tab_correspondance_colonne(51) = 51         'AY
Tab_correspondance_colonne(52) = 52         'AZ
Tab_correspondance_colonne(53) = 53         'BA
Tab_correspondance_colonne(54) = 54         'BB
Tab_correspondance_colonne(55) = 55         'BC
Tab_correspondance_colonne(56) = 56         'BD
Tab_correspondance_colonne(57) = 57         'BE
Tab_correspondance_colonne(58) = 58         'BF
Tab_correspondance_colonne(59) = 59         'BG
Tab_correspondance_colonne(60) = 60         'BH
Tab_correspondance_colonne(61) = 61         'BI
Tab_correspondance_colonne(62) = 62         'BJ
Tab_correspondance_colonne(63) = 63         'BK
Tab_correspondance_colonne(64) = 64         'BL
Tab_correspondance_colonne(65) = 65         'BM
Tab_correspondance_colonne(66) = 66         'BN
Tab_correspondance_colonne(67) = 67         'BO
Tab_correspondance_colonne(68) = 68         'BP
Tab_correspondance_colonne(69) = 69         'BQ
Tab_correspondance_colonne(70) = 70         'BR
Tab_correspondance_colonne(71) = 71         'BS
Tab_correspondance_colonne(72) = 72         'BT

Onglet_source_existe = False
'recherche si l'onglet source n'existe pas dans le fichier
For Each Sh In Worksheets
    If Sh.Name = Onglet_source Then
        Onglet_source_existe = True
        Exit For
    End If
Next Sh
    
    If Onglet_source_existe = False Then
    'ouverture du fichier source
    If Test_fichier_ouvert(Fichier_source) = False Then
        Workbooks.Open Chemin_Fichier_source
    End If
    
'copie de l'onglet utilisé pour éviter les aller retour entre les 2 fichiers
    Windows(Fichier_source).Activate
    Sheets(Onglet_source).Select
    Sheets(Onglet_source).Copy After:=Workbooks(Fichier_cible).Sheets(1)
    
'fermeture du fichier source
    Application.DisplayAlerts = False
        Windows(Fichier_source).Close
    Application.DisplayAlerts = True
End If

'vérrification d'existance du filtre
    If ActiveSheet.FilterMode Then
    'supression des filtres sur la source
    Sheets(Onglet_source).Select
    ActiveSheet.ShowAllData
    End If
    
' Supression des fonctions (macro) de la feuille
    For Each oComposant In ActiveWorkbook.VBProject.VBComponents
    sNomModule = oComposant.Name
     If oComposant.Type = vbext_ct_ClassModule Or vbext_ct_StdModule Or vbext_ct_MSForm Then
         With oComposant.CodeModule
             .DeleteLines 1, .CountOfLines
          End With
        End If
    Next oComposant
            
'Filtre sur le service
    ActiveSheet.Range("$A$3:$BU$1000").AutoFilter Field:=10, Criteria1:= _
        "choix du service"
    Range("A3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    
' Colle les N° de Parts ciblée
    Sheets(Onglet_cible).Select
    Range("A3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("B3").Select
    
    Application.ScreenUpdating = False ' arret affichage
    
' Retour à l'onglet source
    Sheets(Onglet_source).Select
    Range("A3").Select
    
' compte les lignes à traiter
Derligne_cible = Worksheets(Onglet_cible).Range("A36000").End(xlUp).Row
Derligne_source = Worksheets(Onglet_source).Range("A36000").End(xlUp).Row

' Recopie le nombre 3 selules indépendantes
Worksheets(Onglet_cible).Cells(1, 1).Value = Worksheets(Onglet_source).Cells(1, 1).Value
Worksheets(Onglet_cible).Cells(2, 1).Value = Worksheets(Onglet_source).Cells(2, 1).Value
Worksheets(Onglet_cible).Cells(1, 58).Value = Worksheets(Onglet_source).Cells(1, 58).Value

' Traitement des données de correspondance
For i = 3 To Derligne_cible
    If IsNumeric(Worksheets(Onglet_cible).Cells(i, 1).Value) = True Then
        For j = 5 To Derligne_source
            If Worksheets(Onglet_source).Cells(j, 1).Value = Worksheets(Onglet_cible).Cells(i, 1).Value Then
                For k = 1 To UBound(Tab_correspondance_colonne)
                    If Tab_correspondance_colonne(k) <> 0 Then
                        If Worksheets(Onglet_cible).Cells(i, k).Value <> Worksheets(Onglet_source).Cells(j, Tab_correspondance_colonne(k)).Value Then
                            Worksheets(Onglet_cible).Activate
                            Worksheets(Onglet_cible).Cells(i, k).Select
                            With Selection.Interior
                                .Pattern = xlSolid
                                .PatternColorIndex = xlAutomatic
                                .ThemeColor = xlThemeColorAccent2
                                .TintAndShade = 0.399975585192419
                                .PatternTintAndShade = 0
                            End With
                            Worksheets(Onglet_cible).Cells(i, k).Value = Worksheets(Onglet_source).Cells(j, Tab_correspondance_colonne(k)).Value
                        Else
                            Worksheets(Onglet_cible).Activate
                            Worksheets(Onglet_cible).Cells(i, k).Select
                            With Selection.Interior
                                .Pattern = xlNone
                                .TintAndShade = 0
                                .PatternTintAndShade = 0
                            End With
                        End If
                    End If
                Next k
            Exit For
            End If
        Next j
    End If
Next i
    
If Onglet_source_existe = False Then
    'supression de l'onglet source
    Application.DisplayAlerts = False
        Sheets(Onglet_source).Select
        ActiveWindow.SelectedSheets.Delete
    Application.DisplayAlerts = True
End If
        Sheets(Onglet_cible).Select
        Range("A3").Select

' parametrage de l'impression
With Sheets(Onglet_cible)
    .PageSetup.PrintArea = "$A$1:$BK$" & .[A4990].End(xlUp).Row
  End With
  
    Range("BU:XFD").EntireColumn.Hidden = True ' Cacher Collone (True=Oui, False=non)
    Derligne = Worksheets(Onglet_cible).Range("A600").End(xlUp)(20).Row
    Rows(Derligne & ":5040").EntireRow.Hidden = True ' Cacher Collone (True=Oui, False=non)
Application.ScreenUpdating = False ' affichage

End Sub
Function Test_fichier_ouvert(adresse As String) As Boolean

Test_fichier_ouvert = False
For Each fich In Workbooks
    If fich.Name = adresse Then
        Test_fichier_ouvert = True
        Exit For
    End If
Next

End Function

Bonne journée.
 

jose.carreira

XLDnaute Junior
Re : Supression de toutes les macros d'un onglet

Petite erreur de recopie.

A
Code:
Onglet_source = "Onglet_du_fichier_1"
il faut lire
Code:
Onglet_source = "Onglet_du_fichier_2"

desoler
revoilà le code corriger.

Code:
Option Base 1

Sub Macro_MAJ()

Dim Sh As Worksheet

Dim i As Integer

Dim oComposant As VBComponent
Dim sNomModule As String, LigneTitre As String

Dim Derligne_cible As Integer
Dim Derligne_source As Integer
Dim Onglet_source_existe As Boolean
Dim Filtre_actif As Boolean

Dim Chemin_Fichier_source As String
Dim Fichier_source As String
Dim Fichier_cible As String 'ce fichier
Dim Onglet_cible As String
Dim Onglet_source As String
Dim Ligne_SP As String
Dim Max_SP As String

Dim Tab_correspondance_colonne(72) As Integer

Application.ScreenUpdating = False ' arret affichage

' Efface les N° de Parts
    Range("A4").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.ClearContents
    
'Paramètrage des noms de fichiers
Fichier_cible = "Non_du_fichier_1.xlsm"
Chemin_Fichier_source = "Chemin du fichier source c:\\ ou http://"
Fichier_source = "Non_du_fichier_2.xlsm"
Onglet_cible = "Onglet_du_fichier_1"
Onglet_source = "Onglet_du_fichier_2"

'tableau de correspondance des colonne entre les 2 fichier
' Colonne cible = Colonne source    Lettre colonne cible
Tab_correspondance_colonne(1) = 1           'A
Tab_correspondance_colonne(2) = 2           'B
Tab_correspondance_colonne(3) = 3           'C
Tab_correspondance_colonne(4) = 4           'D
Tab_correspondance_colonne(5) = 5           'E
Tab_correspondance_colonne(6) = 6           'F
Tab_correspondance_colonne(7) = 7           'G
Tab_correspondance_colonne(8) = 8           'H
Tab_correspondance_colonne(9) = 9           'I
Tab_correspondance_colonne(10) = 10         'J
Tab_correspondance_colonne(11) = 11         'K
Tab_correspondance_colonne(12) = 12         'L
Tab_correspondance_colonne(13) = 13         'M
Tab_correspondance_colonne(14) = 14         'N
Tab_correspondance_colonne(15) = 15         'O
Tab_correspondance_colonne(16) = 16         'P
Tab_correspondance_colonne(17) = 17         'Q
Tab_correspondance_colonne(18) = 18         'R
Tab_correspondance_colonne(19) = 19         'S
Tab_correspondance_colonne(20) = 20         'T
Tab_correspondance_colonne(21) = 21         'U
Tab_correspondance_colonne(22) = 22         'V
Tab_correspondance_colonne(23) = 23         'W
Tab_correspondance_colonne(24) = 24         'X
Tab_correspondance_colonne(25) = 25         'Y
Tab_correspondance_colonne(26) = 26         'Z
Tab_correspondance_colonne(27) = 27         'AA
Tab_correspondance_colonne(28) = 28         'AB
Tab_correspondance_colonne(29) = 29         'AC
Tab_correspondance_colonne(30) = 30         'AD
Tab_correspondance_colonne(31) = 31         'AE
Tab_correspondance_colonne(32) = 32         'AF
Tab_correspondance_colonne(33) = 33         'AG
Tab_correspondance_colonne(34) = 34         'AH
Tab_correspondance_colonne(35) = 35         'AI
Tab_correspondance_colonne(36) = 36         'AJ
Tab_correspondance_colonne(37) = 37         'AK
Tab_correspondance_colonne(38) = 38         'AL
Tab_correspondance_colonne(39) = 39         'AM
Tab_correspondance_colonne(40) = 40         'AN
Tab_correspondance_colonne(41) = 41         'AO
Tab_correspondance_colonne(42) = 42         'AP
Tab_correspondance_colonne(43) = 43         'AQ
Tab_correspondance_colonne(44) = 44         'AR
Tab_correspondance_colonne(45) = 45         'AS
Tab_correspondance_colonne(46) = 46         'AT
Tab_correspondance_colonne(47) = 47         'AU
Tab_correspondance_colonne(48) = 48         'AV
Tab_correspondance_colonne(49) = 49         'AW
Tab_correspondance_colonne(50) = 50         'AX
Tab_correspondance_colonne(51) = 51         'AY
Tab_correspondance_colonne(52) = 52         'AZ
Tab_correspondance_colonne(53) = 53         'BA
Tab_correspondance_colonne(54) = 54         'BB
Tab_correspondance_colonne(55) = 55         'BC
Tab_correspondance_colonne(56) = 56         'BD
Tab_correspondance_colonne(57) = 57         'BE
Tab_correspondance_colonne(58) = 58         'BF
Tab_correspondance_colonne(59) = 59         'BG
Tab_correspondance_colonne(60) = 60         'BH
Tab_correspondance_colonne(61) = 61         'BI
Tab_correspondance_colonne(62) = 62         'BJ
Tab_correspondance_colonne(63) = 63         'BK
Tab_correspondance_colonne(64) = 64         'BL
Tab_correspondance_colonne(65) = 65         'BM
Tab_correspondance_colonne(66) = 66         'BN
Tab_correspondance_colonne(67) = 67         'BO
Tab_correspondance_colonne(68) = 68         'BP
Tab_correspondance_colonne(69) = 69         'BQ
Tab_correspondance_colonne(70) = 70         'BR
Tab_correspondance_colonne(71) = 71         'BS
Tab_correspondance_colonne(72) = 72         'BT

Onglet_source_existe = False
'recherche si l'onglet source n'existe pas dans le fichier
For Each Sh In Worksheets
    If Sh.Name = Onglet_source Then
        Onglet_source_existe = True
        Exit For
    End If
Next Sh
    
    If Onglet_source_existe = False Then
    'ouverture du fichier source
    If Test_fichier_ouvert(Fichier_source) = False Then
        Workbooks.Open Chemin_Fichier_source
    End If
    
'copie de l'onglet utilisé pour éviter les aller retour entre les 2 fichiers
    Windows(Fichier_source).Activate
    Sheets(Onglet_source).Select
    Sheets(Onglet_source).Copy After:=Workbooks(Fichier_cible).Sheets(1)
    
'fermeture du fichier source
    Application.DisplayAlerts = False
        Windows(Fichier_source).Close
    Application.DisplayAlerts = True
End If

'vérrification d'existance du filtre
    If ActiveSheet.FilterMode Then
    'supression des filtres sur la source
    Sheets(Onglet_source).Select
    ActiveSheet.ShowAllData
    End If
    
' Supression des fonctions (macro) de la feuille
    For Each oComposant In ActiveWorkbook.VBProject.VBComponents
    sNomModule = oComposant.Name
     If oComposant.Type = vbext_ct_ClassModule Or vbext_ct_StdModule Or vbext_ct_MSForm Then
         With oComposant.CodeModule
             .DeleteLines 1, .CountOfLines
          End With
        End If
    Next oComposant
            
'Filtre sur le service
    ActiveSheet.Range("$A$3:$BU$1000").AutoFilter Field:=10, Criteria1:= _
        "choix du service"
    Range("A3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    
' Colle les N° de Parts ciblée
    Sheets(Onglet_cible).Select
    Range("A3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("B3").Select
    
    Application.ScreenUpdating = False ' arret affichage
    
' Retour à l'onglet source
    Sheets(Onglet_source).Select
    Range("A3").Select
    
' compte les lignes à traiter
Derligne_cible = Worksheets(Onglet_cible).Range("A36000").End(xlUp).Row
Derligne_source = Worksheets(Onglet_source).Range("A36000").End(xlUp).Row

' Recopie le nombre 3 selules indépendantes
Worksheets(Onglet_cible).Cells(1, 1).Value = Worksheets(Onglet_source).Cells(1, 1).Value
Worksheets(Onglet_cible).Cells(2, 1).Value = Worksheets(Onglet_source).Cells(2, 1).Value
Worksheets(Onglet_cible).Cells(1, 58).Value = Worksheets(Onglet_source).Cells(1, 58).Value

' Traitement des données de correspondance
For i = 3 To Derligne_cible
    If IsNumeric(Worksheets(Onglet_cible).Cells(i, 1).Value) = True Then
        For j = 5 To Derligne_source
            If Worksheets(Onglet_source).Cells(j, 1).Value = Worksheets(Onglet_cible).Cells(i, 1).Value Then
                For k = 1 To UBound(Tab_correspondance_colonne)
                    If Tab_correspondance_colonne(k) <> 0 Then
                        If Worksheets(Onglet_cible).Cells(i, k).Value <> Worksheets(Onglet_source).Cells(j, Tab_correspondance_colonne(k)).Value Then
                            Worksheets(Onglet_cible).Activate
                            Worksheets(Onglet_cible).Cells(i, k).Select
                            With Selection.Interior
                                .Pattern = xlSolid
                                .PatternColorIndex = xlAutomatic
                                .ThemeColor = xlThemeColorAccent2
                                .TintAndShade = 0.399975585192419
                                .PatternTintAndShade = 0
                            End With
                            Worksheets(Onglet_cible).Cells(i, k).Value = Worksheets(Onglet_source).Cells(j, Tab_correspondance_colonne(k)).Value
                        Else
                            Worksheets(Onglet_cible).Activate
                            Worksheets(Onglet_cible).Cells(i, k).Select
                            With Selection.Interior
                                .Pattern = xlNone
                                .TintAndShade = 0
                                .PatternTintAndShade = 0
                            End With
                        End If
                    End If
                Next k
            Exit For
            End If
        Next j
    End If
Next i
    
If Onglet_source_existe = False Then
    'supression de l'onglet source
    Application.DisplayAlerts = False
        Sheets(Onglet_source).Select
        ActiveWindow.SelectedSheets.Delete
    Application.DisplayAlerts = True
End If
        Sheets(Onglet_cible).Select
        Range("A3").Select

' parametrage de l'impression
With Sheets(Onglet_cible)
    .PageSetup.PrintArea = "$A$1:$BK$" & .[A4990].End(xlUp).Row
  End With
  
    Range("BU:XFD").EntireColumn.Hidden = True ' Cacher Collone (True=Oui, False=non)
    Derligne = Worksheets(Onglet_cible).Range("A600").End(xlUp)(20).Row
    Rows(Derligne & ":5040").EntireRow.Hidden = True ' Cacher Collone (True=Oui, False=non)
Application.ScreenUpdating = False ' affichage

End Sub
Function Test_fichier_ouvert(adresse As String) As Boolean

Test_fichier_ouvert = False
For Each fich In Workbooks
    If fich.Name = adresse Then
        Test_fichier_ouvert = True
        Exit For
    End If
Next

End Function
 

camarchepas

XLDnaute Barbatruc
Re : Supression de toutes les macros d'un onglet

Re José, Michel,

au lieu de :

Code:
'tableau de correspondance des colonne entre les 2 fichier
 ' Colonne cible = Colonne source    Lettre colonne cible
 Tab_correspondance_colonne(1) = 1           'A
 Tab_correspondance_colonne(2) = 2           'B
 Tab_correspondance_colonne(3) = 3           'C
 Tab_correspondance_colonne(4) = 4           'D
 Tab_correspondance_colonne(5) = 5           'E
 Tab_correspondance_colonne(6) = 6           'F
 Tab_correspondance_colonne(7) = 7           'G
 Tab_correspondance_colonne(8) = 8           'H
 Tab_correspondance_colonne(9) = 9           'I
 Tab_correspondance_colonne(10) = 10         'J
 Tab_correspondance_colonne(11) = 11         'K
 Tab_correspondance_colonne(12) = 12         'L
 Tab_correspondance_colonne(13) = 13         'M
 Tab_correspondance_colonne(14) = 14         'N
 Tab_correspondance_colonne(15) = 15         'O
 Tab_correspondance_colonne(16) = 16         'P
 Tab_correspondance_colonne(17) = 17         'Q
 Tab_correspondance_colonne(18) = 18         'R
 Tab_correspondance_colonne(19) = 19         'S
 Tab_correspondance_colonne(20) = 20         'T
 Tab_correspondance_colonne(21) = 21         'U
 Tab_correspondance_colonne(22) = 22         'V
 Tab_correspondance_colonne(23) = 23         'W
 Tab_correspondance_colonne(24) = 24         'X
 Tab_correspondance_colonne(25) = 25         'Y
 Tab_correspondance_colonne(26) = 26         'Z
 Tab_correspondance_colonne(27) = 27         'AA
 Tab_correspondance_colonne(28) = 28         'AB
 Tab_correspondance_colonne(29) = 29         'AC
 Tab_correspondance_colonne(30) = 30         'AD
 Tab_correspondance_colonne(31) = 31         'AE
 Tab_correspondance_colonne(32) = 32         'AF
 Tab_correspondance_colonne(33) = 33         'AG
 Tab_correspondance_colonne(34) = 34         'AH
 Tab_correspondance_colonne(35) = 35         'AI
 Tab_correspondance_colonne(36) = 36         'AJ
 Tab_correspondance_colonne(37) = 37         'AK
 Tab_correspondance_colonne(38) = 38         'AL
 Tab_correspondance_colonne(39) = 39         'AM
 Tab_correspondance_colonne(40) = 40         'AN
 Tab_correspondance_colonne(41) = 41         'AO
 Tab_correspondance_colonne(42) = 42         'AP
 Tab_correspondance_colonne(43) = 43         'AQ
 Tab_correspondance_colonne(44) = 44         'AR
 Tab_correspondance_colonne(45) = 45         'AS
 Tab_correspondance_colonne(46) = 46         'AT
 Tab_correspondance_colonne(47) = 47         'AU
 Tab_correspondance_colonne(48) = 48         'AV
 Tab_correspondance_colonne(49) = 49         'AW
 Tab_correspondance_colonne(50) = 50         'AX
 Tab_correspondance_colonne(51) = 51         'AY
 Tab_correspondance_colonne(52) = 52         'AZ
 Tab_correspondance_colonne(53) = 53         'BA
 Tab_correspondance_colonne(54) = 54         'BB
 Tab_correspondance_colonne(55) = 55         'BC
 Tab_correspondance_colonne(56) = 56         'BD
 Tab_correspondance_colonne(57) = 57         'BE
 Tab_correspondance_colonne(58) = 58         'BF
 Tab_correspondance_colonne(59) = 59         'BG
 Tab_correspondance_colonne(60) = 60         'BH
 Tab_correspondance_colonne(61) = 61         'BI
 Tab_correspondance_colonne(62) = 62         'BJ
 Tab_correspondance_colonne(63) = 63         'BK
 Tab_correspondance_colonne(64) = 64         'BL
 Tab_correspondance_colonne(65) = 65         'BM
 Tab_correspondance_colonne(66) = 66         'BN
 Tab_correspondance_colonne(67) = 67         'BO
 Tab_correspondance_colonne(68) = 68         'BP
 Tab_correspondance_colonne(69) = 69         'BQ
 Tab_correspondance_colonne(70) = 70         'BR
 Tab_correspondance_colonne(71) = 71         'BS
 Tab_correspondance_colonne(72) = 72         'BT

une boucle for next serait surement plus digeste sauf si tu es payé à la ligne de programme bien sur :

Code:
for Tourne = 1 to 72
 Tab_correspondance_colonne(tourne ) = tourne 
next Tourne
 

jose.carreira

XLDnaute Junior
Re : Supression de toutes les macros d'un onglet

Merci.

Je dois avouer que je ne suis pas très calé en VBA.

Tout ce code est issue d’autres ensemble récupérer sur d’autres modules et aussi grâce a « MJ13 » que je remercie encore au passage.

Mais je persévère en m’arrachant quelque cheveux au passage, faut peut-être que je ralentisse car avec l’âge sa repousse bien moins.:D

Sur le principe de la démo les colonnes sont suivi, mais comme je puise sur plusieurs fichier est onglets ce n’est pas toujours le cas.

Mais merci pour le tuyau.

C’est super sympas.
 

MJ13

XLDnaute Barbatruc
Re : Supression de toutes les macros d'un onglet

Re, Bonjour Camarchepas

Merci José pour le code :eek:. Mais quand je parlais du code, je voulais juste celui pour supprimer le module VBA de la feuille.

Sinon, j'ai retrouvé un code un peu plus simple pour supprimer le code de la feuille active :).

Code VBA:
Sub Supprimer_Lignes_Code_Activesheet()
'ThisWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.DeleteLines 1, ThisWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.CountOfLines
ActiveWorkbook.VBProject.VBComponents(ActiveWorkbook.ActiveSheet.CodeName).CodeModule.DeleteLines 1, ActiveWorkbook.VBProject.VBComponents(ActiveWorkbook.ActiveSheet.CodeName).CodeModule.CountOfLines
End Sub
 

Discussions similaires

Statistiques des forums

Discussions
312 495
Messages
2 088 966
Membres
103 993
dernier inscrit
Essens