COMMENT FAIRE DE CES 2 MACROS UNE SEULE

[Eric]

1°) COMMENT LIEE CES 2 MACROS POUR QUELLE NE FASSE PLUS QU'UNE, QUE JE PUISSE AFFECTER A UN BOUTON.

2°) D'AUTRE PART DS UNE LISTE EST T'IL POSSIBLE DE TRIER LES DONNEES CONTENUES S CELLE-CI EN UTILISANT DES FOURCHETTES (COMPRIS ENTRE)

MERCI D'AVANCE POUR VOTRE AIDE.

MACRO(1)

Option Explicit

Const MandatN° = "B3"
Const Prix = "I2"
Const TypeAff = "B7"
Const Secteur = "I7"
Const CP = "C13"
Const Ville = "G13"
Const NbChbre = "H25"
Const Salon = "D33"
Const Sejour = "D32"
Const Terrain = "B60"
Const Garage = "D52"
Const Nom = "B9"
Const Prenom = "H9"


Const NbChamps = 13

Const Masque = "MASQUE SAISIE"
'Le nom du fichier Base
Const FBase = "base.xls"
'le nom de la feuille du fichier Base où copier les données
Const Base = "BASE"


--------------------------------------------------------------------------------------------
Function LastLigne(NomFichier, NomFeuille)
LastLigne = Workbooks(NomFichier).Worksheets(NomFeuille).Range("A65534"). _
End(xlUp).Offset(1, 0).Row
End Function

-------------------------------------------------------------------------------------------
Private Function Is_Ouvert(P_Fichier) As Variant
Is_Ouvert = False
On Error Resume Next
Is_Ouvert = Workbooks(P_Fichier).Name
End Function

-------------------------------------------------------------------------------------------
Sub Valide_Saisie()

Dim Ligne As String
Dim Champs, Boucle As Byte
Dim ValBase
Dim ValMasque



Champs = Array(MandatN°, Prix, TypeAff, Secteur, CP, Ville, NbChbre, Salon, Sejour, Terrain, Garage, Nom, Prenom)

If Is_Ouvert(FBase) = False Then Workbooks.Open FBase
Set ValMasque = ThisWorkbook.Worksheets(Masque)
Set ValBase = Workbooks(FBase).Worksheets(Base)
Ligne = LastLigne(FBase, Base)
For Boucle = LBound(Champs) To UBound(Champs)
'With Worksheets(Masque).Range(Champs(Boucle))
With ValMasque.Range(Champs(Boucle))
ValBase.Cells(Ligne, Boucle + 1).Value = .Value

End With
Next Boucle
End Sub
----------------------------------------------------------------------------------------------
----------------------------------------------------------------------------------------------

MACRO(2)

Sub Enr_Fin()

ChDir "C:\Affiches"
nomrepertoire = CurDir & "\" & Range("B3").Value
If Dir(nomrepertoire, vbDirectory) <> "" Then MsgBox "Répertoire Existant, Validez par OK" Else MkDir nomrepertoire
nomsauvegarde = nomrepertoire & "\" & Range("B3").Value

ActiveWorkbook.SaveAs Filename:=nomsauvegarde, FileFormat _
:=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:= _
False, CreateBackup:=False


ChDir "C:\Eric\Mandats"
ActiveWorkbook.SaveAs Filename:=Range("B3").Value, FileFormat _
:=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:= _
False, CreateBackup:=False

MsgBox "Votre fiche est enregistrée. MERCI."

End Sub