Archiver A partir d'une liste déroulante

Je viens de commencer ce module Facture. L'organigramme:

1 Accueil

2 Paramètres

3 Variables

4 Modele

5 BD Client

6 BD Article

7 Archive

8 Lettre de non paiement

9 Lettre de relance

Dans le modèle, dans la cellule L39, je ne trouve pas la solution.

Le plus dur est incrémenter chaque cellule à l'horizontale de A9 à S9 selon si c'est une facture, devis, simulation.

Cordialement

Laurent

Bonsoir,

un essai voir si ça te va.

https://www.cjoint.com/c/EJjtA1FqHjA

Cordialement.

Merci aucune erreur sur la formule après plus simulation.

Là je souhaiterai que la nouvelle feuille créer du modèle soit dépendante de la liste déroule en "L16" (Devis, Facture, Simulation) soit nommer selon L16 en Facture_1 ou Devis_1 ou Simulation_1 et que cette nouvelle feuille créer une fois enregistrer aille dans Facture_Archive. Je ne sais pas si je suis clair.

Sub Copie_Renomme_Facture()

    'on ouvre les factures déjà existantes
    For Each feuille In Sheets

'        '############################################ Pas encore effectuer ########################
'        'Liste déroulante en L16 pour selectionner Facture, Devis, Simulation
'        If Target.Address(False, False) = "L16" Then
'            Select Case Target.Value
'                Case "Facture": chemin = "C:\Users\Public\Documents\Facture\"
'                    Call Macro1
'                Case "Devis": chemin = "C:\Users\Public\Documents\Devis\"
'                    Call Macro2
'                Case "Simulation": chemin = "C:\Users\Public\Documents\Simulation\"
'                    Call Macro3
'            End Select
'        End If
'        '############################################ Fin Zone Liste déroulante ###################

        If Left(feuille.Name, 7) = "Facture" Then
            feuille.Visible = True
        End If

    Next feuille
    Sheets("Modele").Copy After:=Sheets(Sheets.Count)                                       'copie après le total de feuilles (cad en dernier)
    Sheets("Modele (2)").Name = "Facture" & Space(1) & Sheets.Count - 4                     'renomme l'onglet avec numérotation en prenant : nombre de feuille - feuilles créer = 1,2,3 ...

    '############################################
    'réinitialisation de la facture d'origine
    Sheets("Modele").Select
    'réinitialisation Partie Haute
    Range("M7:N7").Select
    Range("L16").Select
    Range("N16").Select
    Range("J19").Select
    Range("L19:N19").Select
    Selection.ClearContents
    'réinitialisation Partie Centrale
    Range("C24:C35").Select
    Range("J24:J35").Select
    Selection.ClearContents
    'réinitialisation Partie HT
    Range("L38:L39").Select
    Selection.ClearContents
    '############################################

    'on selectionne et colorise la nouvelle facture
    Sheets("Facture" & Space(1) & Sheets.Count - 4).Select
    With ActiveWorkbook.Sheets("Facture" & Space(1) & Sheets.Count - 4).Tab
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = 0.399975585192419
    End With
    Sheets("Facture" & Space(1) & Sheets.Count - 4).Unprotect "admin"
    Sheets("Facture" & Space(1) & Sheets.Count - 4).Shapes("BOUTON").Delete                 'on supprime le bouton dans la nouvelle facture
    Sheets("Facture" & Space(1) & Sheets.Count - 4).Protect "admin"
End Sub

Cordialement

Laurent

Sub Archive()

    Dim Ligne            As Long
    Dim Trouve           As Range

    With Sheets("Facture_Archive")
        Set Trouve = .Range("A:A").Find(Sheets("Facture" & Space(1) & Sheets.Count - 4).Range("G16"), lookat:=xlWhole)
        If Trouve Is Nothing Then
            Ligne = .Range("B" & Rows.Count).End(xlUp).Row + 9

            'N° Facture
            .Range("B" & Ligne) = Sheets("Facture" & Space(1) & Sheets.Count - 4).Range("G16")
            'Date Facture
            .Range("C" & Ligne) = Sheets("Facture" & Space(1) & Sheets.Count - 4).Range("J16")
            'Type
            .Range("D" & Ligne) = Sheets("Facture" & Space(1) & Sheets.Count - 4).Range("L16")
            'ModeLiv
            .Range("E" & Ligne) = Sheets("Facture" & Space(1) & Sheets.Count - 4).Range("N16")
            'Mode règl.
            .Range("F" & Ligne) = Sheets("Facture" & Space(1) & Sheets.Count - 4).Range("J19")
            'Échéance
            .Range("G" & Ligne) = Sheets("Facture" & Space(1) & Sheets.Count - 4).Range("C19")
            'N° de Transaction
            .Range("H" & Ligne) = Sheets("Facture" & Space(1) & Sheets.Count - 4).Range("N19")
            'Nom / Raison Sociale
            .Range("I" & Ligne) = Sheets("Facture" & Space(1) & Sheets.Count - 4).Range("H8")
            'Prénom / Nom
            .Range("J" & Ligne) = Sheets("Facture" & Space(1) & Sheets.Count - 4).Range("I8")
            'Adresse
            .Range("K" & Ligne) = Sheets("Facture" & Space(1) & Sheets.Count - 4).Range("H9")
            'Code Postal
            .Range("L" & Ligne) = Sheets("Facture" & Space(1) & Sheets.Count - 4).Range("H10")
            'Ville
            .Range("M" & Ligne) = Sheets("Facture" & Space(1) & Sheets.Count - 4).Range("J10")
            'Total HT
            .Range("N" & Ligne) = Sheets("Facture" & Space(1) & Sheets.Count - 4).Range("N44")
            'TVA 5,5%
            .Range("O" & Ligne) = Sheets("Facture" & Space(1) & Sheets.Count - 4).Range("N41")
            'TVA 10%
            .Range("P" & Ligne) = Sheets("Facture" & Space(1) & Sheets.Count - 4).Range("N42")
            'TVA 20%
            .Range("Q" & Ligne) = Sheets("Facture" & Space(1) & Sheets.Count - 4).Range("N43")
            'Remise
            .Range("R" & Ligne) = Sheets("Facture" & Space(1) & Sheets.Count - 4).Range("N38")
            'Total TTC
            .Range("S" & Ligne) = Sheets("Facture" & Space(1) & Sheets.Count - 4).Range("N44")
            'Frais de Port
            .Range("T" & Ligne) = Sheets("Facture" & Space(1) & Sheets.Count - 4).Range("N39")
            'Acompte
            .Range("U" & Ligne) = Sheets("Facture" & Space(1) & Sheets.Count - 4).Range("N46")
            'Réglement
            .Range("U" & Ligne) = Sheets("Facture" & Space(1) & Sheets.Count - 4).Range("G48")
        Else
            MsgBox "Facture déjà crée"
        End If
    End With

End Sub
 
 Sub Copie_Renomme_Facture()

    'on ouvre les factures déjà existantes
    For Each feuille In Sheets

'        '############################################ Pas encore effectuer ########################
'        'Liste déroulante en L16 pour selectionner Facture, Devis, Simulation
'        If Target.Address(False, False) = "L16" Then
'            Select Case Target.Value
'                Case "Facture": chemin = "C:\Users\Public\Documents\Facture\"
'                    Call Macro1
'                Case "Devis": chemin = "C:\Users\Public\Documents\Devis\"
'                    Call Macro2
'                Case "Simulation": chemin = "C:\Users\Public\Documents\Simulation\"
'                    Call Macro3
'            End Select
'        End If
'        '############################################ Fin Zone Liste déroulante ###################

        If Left(feuille.Name, 7) = "Facture" Then
            feuille.Visible = True
        End If

    Next feuille
    Sheets("Modele").Copy After:=Sheets(Sheets.Count)                                       'copie après le total de feuilles (cad en dernier)
    Sheets("Modele (2)").Name = "Facture" & Space(1) & Sheets.Count - 4                     'renomme l'onglet avec numérotation en prenant : nombre de feuille - feuilles créer = 1,2,3 ...

    '#################DEBUT######################
    'réinitialisation de la facture d'origine
    Sheets("Modele").Select

    'réinitialisation Partie Haute
    Range("M7:N7").Select
    Range("L16").Select
    Range("N16").Select
    Range("J19").Select
    Range("L19:N19").Select
    Selection.ClearContents

    'réinitialisation Partie Centrale
    Range("C24:C35").Select
    Range("J24:J35").Select
    Selection.ClearContents

    'réinitialisation Partie HT
    Range("L38").Select
    Range("G48").Select
    Range("N46").Select
    Selection.ClearContents
    '###################FIN######################

    'on selectionne et colorise la nouvelle facture
    Sheets("Facture" & Space(1) & Sheets.Count - 4).Select
    With ActiveWorkbook.Sheets("Facture" & Space(1) & Sheets.Count - 4).Tab
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = 0.399975585192419
    End With
    Sheets("Facture" & Space(1) & Sheets.Count - 4).Unprotect "admin"
    Sheets("Facture" & Space(1) & Sheets.Count - 4).Shapes("BOUTON").Delete                 'on supprime le bouton dans la nouvelle facture
    Sheets("Facture" & Space(1) & Sheets.Count - 4).Protect "admin"
End Sub
' 

Je n'arrive pas à synchroniser les 2 formules sous conditions

Cordialement

Laurent

Rechercher des sujets similaires à "archiver partir liste deroulante"