Soucis dans mon code vba excel.

Bonjour, 

Merci pour votre demande d'aide , mais sans le code ou un partie du code VBA, il nous sera  impossible de vous aider . 

pour mettre du code VBA , veuillez dans votre prochain message, l'introduire via le bouton du menu prévu à cet effet . 

ce qui nous affichera ceci par exemple 

Private Sub Commande14_Click()
Dim alert As String
alert = "êtes vous sûr ? "

MsgBox (alert)

End Sub

 Sub CreerFichierETRG2A()
    '  Chargement fiches
    Set uiAura = Sheets("UIAURA")
    Set param = Sheets("PARAMETRES")
    Set fourn = Sheets("FOURNISSEURS")
    '  Récupération du dossier de sauvegarde
    Dim repSauvegarde As String
    repSauvegarde = param.[G2].Value
    Dim annee As String
    annee = param.[G3].Value
    Dim mois As String
    mois = param.[G4].Value
    '  Suppression des alertes
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    
    '  Chargement des modèles
    Dim fichierMain As Variant
    fichierMain = Application.ActiveWorkbook.Name
    Set modele_e = Workbooks(ActiveWorkbook.Name).Worksheets("Modèle-entête")
    Set modele_s = Workbooks(ActiveWorkbook.Name).Worksheets("Modèle-synthèse")
    Set modele_f = Workbooks(ActiveWorkbook.Name).Worksheets("Modèle-Ne-Pas-Facturer")
    '  Récupération des sous domaines
    Set rangeICTR = supprimeValeurNull(param.[B1:B15])
    Set rangeSup = supprimeValeurNull(param.[D1:D50])
    rangeICTR.Copy Destination:=uiAura.range("AP1")
    rangeSup.Rows("2:" + CStr(rangeSup.Count)).Copy Destination:=uiAura.range("AP" + CStr(rangeICTR.Count + 1))
    Set rangeICTRSupersonic = supprimeValeurNull(uiAura.[AP1:AP60])
    
    
   '  Pour chaque fournisseurs...
    For Each C In fourn.range("A2:A" & fourn.[A3000].End(xlUp).Row)
        'DETECTION si contract ICTR or  RCC
        If C Like "* Lot *" Or C Like "*Solution*" Then
        NomFeuille = "RCC"
        NomTotal = "Total Pénalités RCC"
        Else
        NomFeuille = "ICTR"
        NomTotal = "Total Pénalités ICTR"
        End If
    
        fourn.[B2] = C.Value
        modele_e.Copy After:=Sheets(Sheets.Count)
        ' Suppression des lignes inutiles au début pour tmp et renomme la feuille
        Rows(1).EntireRow.Delete
        Rows(1).EntireRow.Delete
        Rows(1).EntireRow.Delete
        ActiveSheet.Name = CStr("tmp")
        
        '  Filtrage pour le fournisseur en cours
         uiAura.[A26].CurrentRegion.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=fourn.[B1:B2], CopyToRange:=[A1:AG1]

        Set tmp = Sheets("tmp")
        '  Filtrage des pénalités null -> On les vires
        tmp.range("A1:AG1").AutoFilter Field:=33, Criteria1:="=0", Operator:=xlFilterValues
        tmp.range("A2:AG100000").SpecialCells(xlCellTypeVisible).Delete
        On Error Resume Next
        tmp.ShowAllData
        
        '  Filtrage des sous domaines spécifiés dans la feuille PARAMETRES
        'Alors l'ancien dev à ici renommé la feuilel en bis etc , Je n'ai pas bien compris pourquoi mais ca marche :x
        tmp.Name = CStr("tmp_bis")
        modele_e.Copy After:=ActiveWorkb
        ook.Worksheets (ActiveWorkbook.Worksheets.Count)
        ActiveSheet.Name = CStr("tmp")
        Set tmp = Sheets("tmp")
        Sheets("tmp_bis").[A2].CurrentRegion.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=rangeICTRSupersonic, CopyToRange:=tmp.[A1:AG1]
        Sheets("tmp_bis").Delete
        On Error GoTo 0
        
        '  Vérification de l'existence du répertoire fournisseur + fichier sauvegarde ref chantiers pénalisés
        If Not dossierExiste(repSauvegarde + C.Value) Then
          MkDir repSauvegarde + C.Value
        End If
        If Not FileExists(repSauvegarde + C.Value + "\" + "chantiers_penalises_" + C.Value & ".xlsx") Then
          Set NewFileChantiersPenalises = Workbooks.Add
          NewFileChantiersPenalises.Sheets(1).[A1] = "Ref chantier"
          NewFileChantiersPenalises.ActiveSheet.Rows(1).EntireRow.Delete
          NewFileChantiersPenalises.ActiveSheet.Name = "Ref chantiers pénalisés"
          NewFileChantiersPenalises.SaveAs repSauvegarde + C.Value + "\" + "chantiers_penalises_" + C.Value & ".xlsx"
          NewFileChantiersPenalises.Close
        End If
        If Not FileExists(repSauvegarde + C.Value + "\" + "ne_pas_facturer_" + C.Value + ".xlsx") Then
          Set newFilePasFact = Workbooks.Add
          modele_f.Copy Before:=newFilePasFact.Worksheets(1)
          newFilePasFact.Sheets("Modèle-Ne-Pas-Facturer").Name = CStr("Chantiers à ne pas facturer")
          newFilePasFact.SaveAs repSauvegarde + C.Value + "\" + "ne_pas_facturer_" + C.Value + ".xlsx"
          newFilePasFact.Close
        End If
        
        Set nonPenal = Workbooks.Open(repSauvegarde + C.Value + "\" + "ne_pas_facturer_" + C.Value + ".xlsx")
        '  Ouverture fichiers réf chantiers pénalisés
        Set penal = Workbooks.Open(repSauvegarde + C.Value + "\" + "chantiers_penalises_" + C.Value & ".xlsx")
        ' On cherche la dernière ligne de penal pour pouvoir copier savoir où stocke rles futures ref chantiers à sauvegarder
        If Not IsEmpty(penal.ActiveSheet.range("A2")) Then
          NextRowPenal = penal.ActiveSheet.range("A2").End(xlDown).Row + 1
        Else
          NextRowPenal = 2
        End If
        
        '  Création fichier fournissseur
        Set NewFile = Workbooks.Add
        modele_e.Copy Before:=NewFile.Sheets(NewFile.Sheets.Count)
        Rows(1).EntireRow.Delete
        Rows(1).EntireRow.Delete
        Rows(1).EntireRow.Delete
        ActiveSheet.Name = CStr("chantiers déjà pénalisés")
        Set dejaPen = Sheets("chantiers déjà pénalisés")
        
        '  Suppression lignes déjà pénalisées dans tmp
        supprimeLigneSiDejaPenalise tmp, penal.Sheets(1), dejaPen, True
        supprimeLigneSiDejaPenalise tmp, nonPenal.Sheets(1), dejaPen, False
        supprimeLigneSiDejaPenaliseIDControle tmp, nonPenal.Sheets(1), dejaPen, False
        nonPenal.Close
        If IsEmpty(dejaPen.range("A2")) Then
          dejaPen.Delete
        End If
        
        ' Filtrage ICTR
        modele_e.Copy Before:=NewFile.Sheets(NewFile.Sheets.Count)
        ActiveSheet.Name = NomFeuille
                       
        On Error GoTo 0
        'Ici j'ai modifié et je suis passé par du mannuel car le copier collez par des filtres c'est extrement gourmant et ca utilisé toute la mémoire de VBA et bloqué la macro
        ExtractionFiltre rangeICTR, tmp, fichierMain, NewFile
        
        ' Filtrage Supersonic
        modele_e.Copy Before:=NewFile.Sheets(NewFile.Sheets.Count)
        ActiveSheet.Name = CStr(param.[C1])

        'Meme chose que pour les contracts ICTR
        On Error GoTo 0
        ExtractionFiltre rangeSup, tmp, fichierMain, NewFile
        On Error Resume Next
        NextRow = range("A2").End(xlDown).Row + 1
       ' On Error GoTo 0
        fourn.[A1] = uiAura.[C1]
        'Filtrage RCC
        
        '  Onglet de synthèse
        modele_s.Copy Before:=NewFile.Sheets(1)
        'ActiveSheet.Name = CStr("Synthèse")
        Worksheets("Modèle-synthèse").Name = CStr("Synthèse")
        Sheets("Synthèse").[B5] = NomTotal
        Sheets("Synthèse").[B2] = C.Value
        Sheets("Synthèse").[D4] = C.Value
        Sheets("Synthèse").[C3] = param.[G1]
        Sheets("Synthèse").[C5].Formula = "=" & NomFeuille & "!E1"
        Sheets("Synthèse").[C6].Formula = "=" & CStr(param.[C1]) & "!E1"
        Sheets("Synthèse").[D5].Formula = "=" & NomFeuille & "!AA3"
        Sheets("Synthèse").[D6].Formula = "=" & CStr(param.[C1]) & "!AA3"
        
        Worksheets("Feuil1").Delete
        ' On cherche la dernière ligne de tmp pour pouvoir copier les ref chantiers dans le fichiers de sauvegarde
        If Not IsEmpty(tmp.range("A1")) Then
          NextRowTmp = tmp.range("A1").End(xlDown).Row + 1
        Else
          NextRowTmp = 2
        End If
        '  Copie des nouvelles réf chantiers
        tmp.range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row).Copy penal.ActiveSheet.range("A" + CStr(NextRowPenal))
        ' Sauvegarde fichier de pénalités
        penal.Save
        penal.Close
        '  Suppression de la feuille temporaire
        tmp.Delete
        ' Vérification existence rep année
        If Not dossierExiste(repSauvegarde + C.Value + "\" + annee) Then
          MkDir repSauvegarde + C.Value + "\" + annee
        End If
        ' Vérification existence rep mois
        If Not dossierExiste(repSauvegarde + C.Value + "\" + annee + "\" + mois) Then
          MkDir repSauvegarde + C.Value + "\" + annee + "\" + mois
        End If
        ' Sauvegarde fichier de pénalités ICTR/SUPERSONIC
        If Not WorksheetExists("chantiers déjà pénalisés") Then
          NewFile.SaveAs repSauvegarde + C.Value + "\" + annee + "\" + mois + "\" + C.Value & "_" & mois & ".xlsx"
          NewFile.Close
        Else
          Set NewFileBis = NewFile
          NewFileBis.SaveAs repSauvegarde + C.Value + "\" + annee + "\" + mois + "\" + C.Value & "_" & mois & "_debug.xlsx"
          NewFile.Sheets("chantiers déjà pénalisés").Delete
          NewFile.SaveAs repSauvegarde + C.Value + "\" + annee + "\" + mois + "\" + C.Value & "_" & mois & ".xlsx"
          NewFile.Close
        End If
    Next C
    uiAura.range("$A$26:$AG$100000").AutoFilter
    fourn.[B2] = ""
    uiAura.Select
End Sub