Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

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

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

SaiSai Boundao

XLDnaute Nouveau
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 😕😱😀😱😕😀😱😉😉😉
 
Dernière édition:
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
1
Affichages
221
Réponses
10
Affichages
603
Réponses
5
Affichages
530
  • Question Question
Microsoft 365 worksheet_change
Réponses
29
Affichages
801
Réponses
4
Affichages
397
Réponses
4
Affichages
591
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…