'déclaration des Long
Dim ligne As Long
Dim I As Long
Dim DernLigne As Long
Dim DernLigne2 As Long
Dim j As Long
Dim taille As Long
Dim nb_fichier As Long
Dim nb_ligne As Long

'déclaration des String
Dim racine As String
Dim Extension As String
Dim Fichier As String
Dim Chemin As String
Dim F_Macro As String
Dim F_Macro2 As String
Dim F_Fichier As String
Dim F_Temp As String
Dim dossier As String

'déclaration des FileDialog
Dim F_Repertoire As FileDialog

'déclaration des Range
Dim Celladr As Range

'_______________________________________________________

Sub prepare_od_ad()

' Pas d'affichage durant la macro
    Application.ScreenUpdating = False
    
' Pas de boite d'alerte durant la macro
    Application.DisplayAlerts = False
    
' Sélection et ouverture du fichier à répartir par l'utilisateur

    MsgBox ("Sélectionnez le fichier à préparer")
    ChDir "D:\"
    F_Macro = Application.GetOpenFilename()

    ' si aucun choix effectué, sortie du programme
    If F_Macro = "Faux" Then
        MsgBox ("Aucun fichier n'a été sélectionné. Fin de la procédure.")
        Exit Sub
    End If

    Workbooks.Open (F_Macro), Local:=True

' création du fichier ETM
    
    'mise en forme de la colonne matricule
        Set Celladr = Rows("1").Find("matricule", LookAt:=xlWhole)
        Columns(Celladr.Column).NumberFormat = "0"
        
    'mise en forme de la colonne matricule_benef
        Set Celladr = Rows("1").Find("matricule bénéf", LookAt:=xlWhole)
        Columns(Celladr.Column).NumberFormat = "0"
        
    'recherche et remplace "ddn"
        Set Celladr = Rows("1").Find("ddn", LookAt:=xlWhole)

        If Celladr Is Nothing Then
            Else
                Celladr.Select
                ActiveCell.Value = "BENEF"
        End If
    
    'Suppression des colonnes jusque code ETM
        Do While Range("I1").Value <> "Code ETM 1"
            Columns(9).Delete
        Loop

    'Suppression des colonnes après les ETM
        Do While Range("L1").Value <> ""
            Columns(12).Delete
        Loop

    'Suppression des lignes sans ETM
        DernLigne = Range("A" & Rows.Count).End(xlUp).Row
        
       For I = 2 To DernLigne
            If Range("I" & I).Value = "" Then
                 Rows(I).Delete
                 I = I - 1
                 DernLigne = Range("A" & Rows.Count).End(xlUp).Row
            End If
                j = I + 1
            If Range("A" & j).Value = "" Then
                Exit For
            End If
        Next

    'recherche et remplace "Code ETM 1"
        Set Celladr = Rows("1").Find("Code ETM 1", LookAt:=xlWhole)

        If Celladr Is Nothing Then
            Else
                Celladr.Select
                ActiveCell.Value = "Nat_ETM"
        End If

    'recherche et remplace "Date début ETM 1"
        Set Celladr = Rows("1").Find("Date début ETM 1", LookAt:=xlWhole)

        If Celladr Is Nothing Then
            Else
                Celladr.Select
                ActiveCell.Value = "Deb_ETM"
        End If


    'recherche et remplace "Date fin ETM 1"
        Set Celladr = Rows("1").Find("Date fin ETM 1", LookAt:=xlWhole)

        If Celladr Is Nothing Then
            Else
                Celladr.Select
                ActiveCell.Value = "Fin_ETM"
        End If

    'ajout de la colonne "Action_ETM"
        Range("L1").Value = "Action_ETM"
    'ajout de l'action ETM a réaliser
        DernLigne = Range("A" & Rows.Count).End(xlUp).Row
        
        For I = 2 To DernLigne
           Range("L" & I).Value = "CRE"
        Next

        'Range("A1").Select
        Cells(1, 1).Select
        
    'Donne à la variable "Fichier" le nom du fichier ouvert (sans extension)
        Fichier = CreateObject("Scripting.FileSystemObject").GetbaseName(F_Macro)
    'récupère le chemin du fichier
        Chemin = Workbooks(ActiveWorkbook.Name).Path

        F_Temp = Chemin & "\" & Fichier & " ETM à saisir.xlsx"
        ActiveWorkbook.SaveAs Filename:=F_Temp, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False, Local:=True
        ActiveWorkbook.Close savechanges:=False
        
Workbooks.Open Filename:=F_Macro, Local:=True

'création du fichier MTT
        
     'mise en forme de la colonne matricule
        Set Celladr = Rows("1").Find("matricule", LookAt:=xlWhole)
        Columns(Celladr.Column).NumberFormat = "0"
        
    'mise en forme de la colonne matricule_benef
        Set Celladr = Rows("1").Find("matricule bénéf", LookAt:=xlWhole)
        Columns(Celladr.Column).NumberFormat = "0"
        
    'recherche et remplace "ddn"
        Set Celladr = Rows("1").Find("ddn", LookAt:=xlWhole)

        If Celladr Is Nothing Then
            Else
                Celladr.Select
                ActiveCell.Value = "BENEF"
        End If
        
    'Suppression des colonnes jusque code MTT
        Do While Range("I1").Value <> "Numéro MTT 1"
            Columns(9).Delete
        Loop
   
    'Suppression des colonnes après les MTT
        Do While Range("L1").Value <> ""
            Columns(12).Delete
        Loop
        
    'Suppression des lignes sans MTT
        DernLigne = Range("A" & Rows.Count).End(xlUp).Row
        
       For I = 2 To DernLigne
            If Range("I" & I).Value = "" Then
                 Rows(I).Delete
                 I = I - 1
                 DernLigne = Range("A" & Rows.Count).End(xlUp).Row
            End If
                j = I + 1
            If Range("A" & j).Value = "" Then
                Exit For
            End If
        Next
        
     'Suppression des lignes avec MTT périmé
        DernLigne = Range("A" & Rows.Count).End(xlUp).Row
        
       For I = 2 To DernLigne
            If Range("K" & I).Value <> "" Then
                 Rows(I).Delete
                 I = I - 1
                 DernLigne = Range("A" & Rows.Count).End(xlUp).Row
            End If
                j = I + 1
            If Range("A" & j).Value = "" Then
                Exit For
            End If
        Next
        
    'recherche et remplace "Numéro MTT 1"
        Set Celladr = Rows("1").Find("Numéro MTT 1", LookAt:=xlWhole)

        If Celladr Is Nothing Then
            Else
                Celladr.Select
                ActiveCell.Value = "NUM_MTT"
        End If
        
    'recherche et remplace "Date début MTT 1"
        Set Celladr = Rows("1").Find("Date début MTT 1", LookAt:=xlWhole)

        If Celladr Is Nothing Then
            Else
                Celladr.Select
                ActiveCell.Value = "DEB_MTT"
        End If
        
    'recherche et remplace "Date fin MTT 1"
        Set Celladr = Rows("1").Find("Date fin MTT 1", LookAt:=xlWhole)

        If Celladr Is Nothing Then
            Else
                Celladr.Select
                ActiveCell.Value = "FIN_MTT"
        End If

    'ajout de la colonne "MOTIF_FIN_MTT"
        Range("L1").Value = "MOTIF_FIN_MTT"
        
    'ajout de la colonne "ACTION_MTT"
        Range("M1").Value = "ACTION_MTT"
    'ajout de l'action MTT a réaliser
        DernLigne = Range("A" & Rows.Count).End(xlUp).Row
        
        For I = 2 To DernLigne
           Range("M" & I).Value = "CRE"
        Next

        'Range("A1").Select
        Cells(1, 1).Select
        
    'Donne à la variable "Fichier" le nom du fichier ouvert (sans extension)
        Fichier = CreateObject("Scripting.FileSystemObject").GetbaseName(F_Macro)
    'récupère le chemin du fichier
        Chemin = Workbooks(ActiveWorkbook.Name).Path

        F_Temp = Chemin & "\" & Fichier & " MTT à saisir.xlsx"
        ActiveWorkbook.SaveAs Filename:=F_Temp, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False, Local:=True
        ActiveWorkbook.Close savechanges:=False
        
Workbooks.Open Filename:=F_Macro, Local:=True

'création du fichier OC
        
    'mise en forme de la colonne matricule
        Set Celladr = Rows("1").Find("matricule", LookAt:=xlWhole)
        Columns(Celladr.Column).NumberFormat = "0"
        
    'mise en forme de la colonne matricule_benef
        Set Celladr = Rows("1").Find("matricule bénéf", LookAt:=xlWhole)
        Columns(Celladr.Column).NumberFormat = "0"
        
    'recherche et remplace "ddn"
        Set Celladr = Rows("1").Find("ddn", LookAt:=xlWhole)

        If Celladr Is Nothing Then
            Else
                Celladr.Select
                ActiveCell.Value = "BENEF"
        End If
        
   'Suppression des colonnes jusque numéro OC
        Do While Range("I1").Value <> "Numéro OC 1"
            Columns(9).Delete
        Loop
        
    'Suppression des colonnes après les OC
        Do While Range("N1").Value <> ""
            Columns(14).Delete
        Loop
        
     'Suppression des lignes sans OC
        DernLigne = Range("A" & Rows.Count).End(xlUp).Row
        
       For I = 2 To DernLigne
            If Range("I" & I).Value = "" Then
                 Rows(I).Delete
                 I = I - 1
                 DernLigne = Range("A" & Rows.Count).End(xlUp).Row
            End If
                j = I + 1
            If Range("A" & j).Value = "" Then
                Exit For
            End If
        Next
        
    'Suppression des lignes avec OC périmé
        DernLigne = Range("A" & Rows.Count).End(xlUp).Row
        
       For I = 2 To DernLigne
            If Range("M" & I).Value < DateSerial(Year(Date), Month(Date) - 27, Day(Date)) Then
                 Rows(I).Delete
                 I = I - 1
                 DernLigne = Range("A" & Rows.Count).End(xlUp).Row
            End If
                j = I + 1
            If Range("A" & j).Value = "" Then
                Exit For
            End If
        Next
        
    'recherche et remplace "Numéro OC 1"
        Set Celladr = Rows("1").Find("Numéro OC 1", LookAt:=xlWhole)

        If Celladr Is Nothing Then
            Else
                Celladr.Select
                ActiveCell.Value = "organisme"
        End If
        
    'recherche et remplace "Adhérent OC 1"
        Set Celladr = Rows("1").Find("Adhérent OC 1", LookAt:=xlWhole)

        If Celladr Is Nothing Then
            Else
                Celladr.Select
                ActiveCell.Value = "adhérent"
        End If
        
    'recherche et remplace "Contrat OC 1"
        Set Celladr = Rows("1").Find("Contrat OC 1", LookAt:=xlWhole)

        If Celladr Is Nothing Then
            Else
                Celladr.Select
                ActiveCell.Value = "Type contrat"
        End If
                
    'recherche et remplace "Date début OC 1"
        Set Celladr = Rows("1").Find("Date début OC 1", LookAt:=xlWhole)

        If Celladr Is Nothing Then
            Else
                Celladr.Select
                ActiveCell.Value = "début contrat"
        End If
                    
     'recherche et remplace "Date fin OC 1"
        Set Celladr = Rows("1").Find("Date fin OC 1", LookAt:=xlWhole)

        If Celladr Is Nothing Then
            Else
                Celladr.Select
                ActiveCell.Value = "fin contrat"
        End If
               
        'Range("A1").Select
        Cells(1, 1).Select
        
    'Donne à la variable "Fichier" le nom du fichier ouvert (sans extension)
        Fichier = CreateObject("Scripting.FileSystemObject").GetbaseName(F_Macro)
    'récupère le chemin du fichier
        Chemin = Workbooks(ActiveWorkbook.Name).Path

        F_Temp = Chemin & "\" & Fichier & " OC à saisir.xlsx"
        ActiveWorkbook.SaveAs Filename:=F_Temp, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False, Local:=True
        ActiveWorkbook.Close savechanges:=False
        
Workbooks.Open Filename:=F_Macro, Local:=True
               


MsgBox ("Fichier Prêt")
              
End Sub