Sub Archivage()
Dim Lg As Long
' Cette macro est déclenchée par le bouton Archiver
' Récupère les N° de documents
NumFa = ActiveSheet.Range("G15")
NumBL = ActiveSheet.Range("G77")
' Recherche dans la feuille de registre si les N° sont déjà enregistrés
With Sheets("Registre")
' Définit le type de document (Facture ou BL)
TypDoc = ActiveSheet.Name
' Récupération de la première ligne vide dans la feuille de registre
Lg = .Range("A65536").End(xlUp).Row + 1
Select Case TypDoc
Case Is = "BL"
NumBL = ActiveSheet.Range("G15")
If Not .Range("A:A").Find("BL" & NumBL, LookIn:=xlValues, lookat:=xlWhole) Is Nothing Then
MsgBox "Ce numéro de BL existe déjà !", vbOKOnly + vbecxlamation, "ERREUR DE N°"
Cancel = True
ActiveSheet.Range("G15") = ""
ActiveSheet.Range("G15").Select
Exit Sub
End If
.Cells(Lg, 1) = "BL" & NumBL
[U]' ActiveSheet.Copy after:=Sheets(Sheets.Count)
' ActiveSheet.Name = TypDoc & "-" & NumBL
' ActiveSheet.Tab.ColorIndex = -4142
' Sheets(TypDoc).Select[/U]
Case Is = "Fa"
NumFa = ActiveSheet.Range("G15")
If Not .Range("A:A").Find(NumFa, LookIn:=xlValues, lookat:=xlWhole) Is Nothing Then
MsgBox "Ce numéro de facture existe déjà !", vbOKOnly + vbecxlamation, "ERREUR DE N°"
Cancel = True
ActiveSheet.Range("G15") = ""
ActiveSheet.Range("G15").Select
Exit Sub
End If
.Cells(Lg, 1) = NumFa
[U]' ActiveSheet.Copy after:=Sheets(Sheets.Count)
' ActiveSheet.Name = TypDoc & "-" & NumFa
' ActiveSheet.Tab.ColorIndex = -4142
' Sheets(TypDoc).Select[/U]
Case Is = "Fa + BL"
NumFa = ActiveSheet.Range("G15")
NumBL = ActiveSheet.Range("G77")
If Not .Range("A:A").Find(NumFa, LookIn:=xlValues, lookat:=xlWhole) Is Nothing Then
MsgBox "Ce numéro de facture existe déjà !", vbOKOnly + vbecxlamation, "ERREUR DE N°"
Cancel = True
ActiveSheet.Range("G15") = ""
ActiveSheet.Range("G15").Select
Exit Sub
End If
.Cells(Lg, 1) = NumFa
If Not .Range("A:A").Find("BL" & NumBL, LookIn:=xlValues, lookat:=xlWhole) Is Nothing Then
MsgBox "Ce numéro de BL existe déjà !", vbOKOnly + vbecxlamation, "ERREUR DE N°"
Cancel = True
ActiveSheet.Range("G77") = ""
ActiveSheet.Range("G77").Select
Exit Sub
End If
If Not NumBL = "" Then .Cells(Lg + 1, 1) = "BL" & NumBL
End Select
If Not NumFa = "" Then
For Each Cel In ActiveSheet.Range("D2[COLOR="Red"][B]4[/B][/COLOR]:D42")
Produit = Cel.Value
Set prod = Sheets("Produits").Range("A:A").Find(Produit, LookIn:=xlValues)
Produit = Sheets("Produits").Cells(prod.Row, 2)
If Produit = "" Then Exit For
Set Col = .Range("2:2").Find(Produit, LookIn:=xlValues)
Col = Col.Column
.Cells(Lg, Col) = ActiveSheet.Cells(Cel.Row, 5)
.Cells(Lg, 2) = ActiveSheet.Range("G45")
.Cells(Lg, 3) = ActiveSheet.Range("G12")
.Cells(Lg, 4) = ActiveSheet.Range("D15")
Next
End If
If Not NumBL = "" Then
For Each Cel In ActiveSheet.Range("D8[COLOR="Red"][B]5[/B][/COLOR]:D103")
Produit = Cel.Value
Set prod = Sheets("Produits").Range("A:A").Find(Produit, LookIn:=xlValues)
Produit = Sheets("Produits").Cells(prod.Row, 2)
If Produit = "" Then Exit For
Set Col = .Range("2:2").Find(Produit, LookIn:=xlValues)
Col = Col.Column
.Cells(Lg + 1, Col) = ActiveSheet.Cells(Cel.Row, 5)
.Cells(Lg + 1, 2) = ActiveSheet.Range("G115")
.Cells(Lg + 1, 3) = ActiveSheet.Range("G73")
.Cells(Lg + 1, 4) = ActiveSheet.Range("D76")
Next
End If
End With
With ActiveSheet
.Copy after:=Sheets(Sheets.Count)
Select Case TypDoc
Case Is = "Fa + BL"
nf = Replace(TypDoc, " +", NumFa & " +")
nf = Replace(nf, "BL", "BL" & NumBL)
Case Is = "Fa"
nf = TypDoc & NumFa
Case Is = "BL"
nf = TypDoc & NumBL
End Select
Sheets(Sheets.Count).Name = nf
Sheets(Sheets.Count).Tab.ColorIndex = -4142
End With
MsgBox "La feuille """ & ActiveSheet.Name & """ a bien été enregistrée !", vbOKOnly + vbInformation, "SAUVEGARDE RÉUSSIE"
With Sheets(TypDoc)
.Select
.Range("G12") = Date
.Range("G15:G18").ClearContents
.Range("D13:D18,D2[COLOR="Red"][B]4[/B][/COLOR]:F42").ClearContents
.Range("G77:G79").ClearContents
End With
End Sub