Enregistrer des données dans un classeur archive portant le nom d'une cellule

[SaiSai Boundao]

Bonjour a toutes et a tous,

Je suis un nouveau dans le monde du VBA et mes premières petites macros fonctionnent bien...j'essaie de passer au niveau supérieur...mais je "level up" pas

Dans la premiere partie de la macro je copie des cellules dans une feuilles d'archive "restreinte" du meme classeur.

Puis dans la seconde partie (la ou ça bloque) je souhaite copier dans un classeur d'archivage (deja créé : sap001 à sap250) la "fiche de PRODUCTION" de mon classeur "BORA" sur des feuilles comportant la date et l'heure.

Par exemple : si je produit la reference "sap001"" notée en (3,4) de mon activesheet, je souhaite avoir une copie de cette feuille dans le classeur "sap001" sur la feuille "27-03-12_16h00"

Voici mon petit code :



Sub archivagebora()


'Ici copie de cellules résumant la production
'
Dim Ligne As Long



Ligne = Sheets("Archives").Range("A" & Rows.Count).End(xlUp).Row + 1


Sheets("Fiche de PRODUCTION").Unprotect Password:="macsapin"

Sheets("Archives").Range("A" & Ligne).Value = Sheets("Fiche de PRODUCTION").Range("c3").Value
Sheets("Archives").Range("B" & Ligne).Value = Sheets("Fiche de PRODUCTION").Range("c4").Value
Sheets("Archives").Range("C" & Ligne).Value = Sheets("Fiche de PRODUCTION").Range("f4").Value
Sheets("Archives").Range("D" & Ligne).Value = Sheets("Fiche de PRODUCTION").Range("e3").Value
Sheets("Archives").Range("E" & Ligne).Value = Sheets("Fiche de PRODUCTION").Range("g3").Value
Sheets("Archives").Range("F" & Ligne).Value = Sheets("Fiche de PRODUCTION").Range("e44").Value
Sheets("Archives").Range("G" & Ligne).Value = Sheets("Fiche de PRODUCTION").Range("e25").Value
Sheets("Archives").Range("H" & Ligne).Value = Sheets("Fiche de PRODUCTION").Range("f44").Value
Sheets("Archives").Range("I" & Ligne).Value = Sheets("Fiche de PRODUCTION").Range("h44").Value
Sheets("Archives").Range("J" & Ligne).Value = Sheets("Fiche de PRODUCTION").Range("g25").Value
Sheets("Archives").Range("K" & Ligne).Value = Sheets("Fiche de PRODUCTION").Range("i44").Value
Sheets("Archives").Range("L" & Ligne).Value = Sheets("Fiche de PRODUCTION").Range("h46").Value
Sheets("Archives").Range("M" & Ligne).Value = Sheets("Fiche de PRODUCTION").Range("i46").Value

Sheets("Fiche de PRODUCTION").Protect Password:="macsapin"
'
'
'Ici copie du tableau dans le dossier DATA, dans un nouveau classeur dont le nom est le SAP et la date
'
Dim origine As Workbook
Dim archive As Workbook
Dim CodDossier As String
Dim Prod As Range, Derlgin As Long

Application.ScreenUpdating = False
origine = ThisWorkbook
CodDossier = ThisWorkbook.Sheets("Fiche de PRODUCTION").Cells(4, 3)
archive = Workbooks.Open("C:\Bora\Data\" & "CodDossier")
With origine.ActiveSheet
Set Prod = .Range("B3:J" & .Range("A65536").End(xlUp).Row)
End With
With archive.Sheets(Date, "_dd-mm-yyyy") & Format(Time, "_hhmm")
derlign = .Range("A65536").End(xlUp).Row
Prod.Copy .Range("B" & derlign + 1)
.Columns("B:J").AutoFit
End With
archive.Save
archive.Close
Application.ScreenUpdating = True

end sub


SVP sauvez moi