Enregistrement des onglets en fichier + un modèle
Linoa
-
Kalissi Messages postés 221 Statut Membre -
Kalissi Messages postés 221 Statut Membre -
Bonjour,
J’ai un classeur qui reprend l’historique des augmentations, promotions… accordées aux salariés (environ 2000).
Dans un premier temps je crée à chaque changement de service (colonne L) un onglet avec le numéro de service comme nom. Ensuite j’enregistre chacune des feuilles dans un classeur à part.
Voici en code :
Sub creation_onglets()
Dim contenu As String
Dim lig As Long, derlig As Long
With Sheets("HIST")
derlig = .Range("L" & Rows.Count).End(xlUp).Row
For lig = 2 To derlig
contenu = .Cells(lig, 12).Value
If contenu = "" Then GoTo Suite
If FeuilleExiste(ThisWorkbook, contenu) Then
.Rows(lig).Copy Sheets(contenu).Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
Else
Sheets.Add
ActiveSheet.Name = contenu
.Rows(1).Copy Sheets(contenu).Range("A1")
.Rows(lig).Copy Sheets(contenu).Range("A2")
End If
Suite:
Next lig
End With
End Sub
Function FeuilleExiste(wk As Workbook, stFeuille) As Boolean
On Error Resume Next
FeuilleExiste = Not (wk.Sheets(stFeuille) Is Nothing)
End Function
Sub saveOnglet()
Dim ws
Dim newWk As Workbook
For Each ws In Worksheets
Set newWk = Workbooks.Add(xlWBATWorksheet)
ws.Copy newWk.Sheets(1)
newWk.SaveAs ("H" & ws.Name & ".xlsx")
newWk.Close
Set newWk = Nothing
Next ws
End Sub
Ensuite manuellement pour chaque historique de service (plus de 100 fichiers) j’insère une feuille, je nomme ma plage de donnée, je protège classeur et feuille…
Ma question est : serait-il possible de faire en sorte qu’à l’enregistrement de tous les fichiers les étapes manuelles soient exécutées ?
Etant débutant en VBA je prends des bouts de code sur les forums..., il est donc possible que les codes ci-haut ne soient par « optimums ».
Merci de votre aide et compréhension,
J’ai un classeur qui reprend l’historique des augmentations, promotions… accordées aux salariés (environ 2000).
Dans un premier temps je crée à chaque changement de service (colonne L) un onglet avec le numéro de service comme nom. Ensuite j’enregistre chacune des feuilles dans un classeur à part.
Voici en code :
Sub creation_onglets()
Dim contenu As String
Dim lig As Long, derlig As Long
With Sheets("HIST")
derlig = .Range("L" & Rows.Count).End(xlUp).Row
For lig = 2 To derlig
contenu = .Cells(lig, 12).Value
If contenu = "" Then GoTo Suite
If FeuilleExiste(ThisWorkbook, contenu) Then
.Rows(lig).Copy Sheets(contenu).Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
Else
Sheets.Add
ActiveSheet.Name = contenu
.Rows(1).Copy Sheets(contenu).Range("A1")
.Rows(lig).Copy Sheets(contenu).Range("A2")
End If
Suite:
Next lig
End With
End Sub
Function FeuilleExiste(wk As Workbook, stFeuille) As Boolean
On Error Resume Next
FeuilleExiste = Not (wk.Sheets(stFeuille) Is Nothing)
End Function
Sub saveOnglet()
Dim ws
Dim newWk As Workbook
For Each ws In Worksheets
Set newWk = Workbooks.Add(xlWBATWorksheet)
ws.Copy newWk.Sheets(1)
newWk.SaveAs ("H" & ws.Name & ".xlsx")
newWk.Close
Set newWk = Nothing
Next ws
End Sub
Ensuite manuellement pour chaque historique de service (plus de 100 fichiers) j’insère une feuille, je nomme ma plage de donnée, je protège classeur et feuille…
Ma question est : serait-il possible de faire en sorte qu’à l’enregistrement de tous les fichiers les étapes manuelles soient exécutées ?
Etant débutant en VBA je prends des bouts de code sur les forums..., il est donc possible que les codes ci-haut ne soient par « optimums ».
Merci de votre aide et compréhension,
A voir également:
- Enregistrement des onglets en fichier + un modèle
- Fichier bin - Guide
- Comment réduire la taille d'un fichier - Guide
- Fichier epub - Guide
- Fichier rar - Guide
- Fichier .dat - Guide
4 réponses
Bonjour,
Outre le GOTO que je ne conseille pas :
Oui, tu peux effectuer les manipulations par VBA.
1.) Place toi au début des manipulations manuelles
2.) Lance l'enregistreur de macro
3.) Effectue les opérations manuelles
4.) Arrête l'enregistreur de macro.
Va voir le code généré et insère celui-ci dans la boucle de sauvegarde.
S'il te faut de l'aide, copie/colle le code ici et il sera possible de t'aider pour le fignolage.
K
Outre le GOTO que je ne conseille pas :
Option Explicit
Sub Creation_Onglets()
Dim contenu As String
Dim lig As Long, derlig As Long
With Sheets("HIST")
derlig = .Range("L" & Rows.Count).End(xlUp).Row
For lig = 2 To derlig
contenu = .Cells(lig, 12).Value
If Not contenu = "" Then
If FeuilleExiste(ThisWorkbook, contenu) Then
.Rows(lig).Copy Sheets(contenu).Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
Else
Sheets.Add
ActiveSheet.Name = contenu
.Rows(1).Copy Sheets(contenu).Range("A1")
.Rows(lig).Copy Sheets(contenu).Range("A2")
End If
End If
Next lig
End With
End Sub
'
Function FeuilleExiste(wk As Workbook, stFeuille) As Boolean
On Error Resume Next
FeuilleExiste = Not (wk.Sheets(stFeuille) Is Nothing)
End Function
'
Sub SaveOnglet()
Dim ws As Worksheet
Dim newWk As Workbook
For Each ws In Worksheets
Set newWk = Workbooks.Add(xlWBATWorksheet)
ws.Copy newWk.Sheets(1)
newWk.SaveAs ("H" & ws.Name & ".xlsx")
newWk.Close
Set newWk = Nothing
Next ws
End Sub
Oui, tu peux effectuer les manipulations par VBA.
1.) Place toi au début des manipulations manuelles
2.) Lance l'enregistreur de macro
3.) Effectue les opérations manuelles
4.) Arrête l'enregistreur de macro.
Va voir le code généré et insère celui-ci dans la boucle de sauvegarde.
S'il te faut de l'aide, copie/colle le code ici et il sera possible de t'aider pour le fignolage.
K
OK déjà merci pour cette première réponse !
Pensant que ce n'était pas possible je suis un peu prise au dépourvu... Je mets rapidement le résultat de l'enregistrement.
Encore merci,
Pensant que ce n'était pas possible je suis un peu prise au dépourvu... Je mets rapidement le résultat de l'enregistrement.
Encore merci,
Re bonjour,
Voici ce que donne l'enregisteur de Macro, sachant que je suis parti d'un fichier (A-4511) généré par la macro SaveOnglet :
Sub Macro()
Sheets("A-4511").Select
Sheets("A-4511").Name = "OUTIL"
Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
ActiveWorkbook.Names.Add Name:="NUMAGENT", RefersToR1C1:= _
"=OUTIL!R2C1:R100C1"
Sheets("OUTIL").Select
ActiveWindow.SelectedSheets.Visible = False
Windows("Modele.xlsx").Activate
Sheets("PROPOSITIONS").Select
Sheets("PROPOSITIONS").Copy Before:=Workbooks("A-4511.xlsx").Sheets(2)
Range("B11").Select
ActiveCell.FormulaR1C1 = "=OUTIL!R[-9]C[6]"
Range("E11").Select
ActiveCell.FormulaR1C1 = "=OUTIL!R[-9]C"
Range("A17:A40").Select
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=NUMAGENT"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
Range("A17").Select
ActiveWorkbook.Protect Structure:=True, Windows:=False
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFormattingColumns:=True, AllowFormattingRows:=True
End Sub
Si j'essaye de m'expliquer :
1/ Mettre OUTIL a la place des numéros de service
2/ Prendre l'ensemble des données en A pour créer une plage nommé NUMAGENT
3/ Masquer la feuille OUTIL
4/ En B11 formule OUTIL!H2
5/ En B11 formule OUTIL!G2
6/ Sur la feuille PROPOSITIONS de A17:A40 liste déroulante avec la plage NUMAGENT
7/ Protéger la feuille
8/ Protéger le classeur
Merci 1000 fois,
Voici ce que donne l'enregisteur de Macro, sachant que je suis parti d'un fichier (A-4511) généré par la macro SaveOnglet :
Sub Macro()
Sheets("A-4511").Select
Sheets("A-4511").Name = "OUTIL"
Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
ActiveWorkbook.Names.Add Name:="NUMAGENT", RefersToR1C1:= _
"=OUTIL!R2C1:R100C1"
Sheets("OUTIL").Select
ActiveWindow.SelectedSheets.Visible = False
Windows("Modele.xlsx").Activate
Sheets("PROPOSITIONS").Select
Sheets("PROPOSITIONS").Copy Before:=Workbooks("A-4511.xlsx").Sheets(2)
Range("B11").Select
ActiveCell.FormulaR1C1 = "=OUTIL!R[-9]C[6]"
Range("E11").Select
ActiveCell.FormulaR1C1 = "=OUTIL!R[-9]C"
Range("A17:A40").Select
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=NUMAGENT"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
Range("A17").Select
ActiveWorkbook.Protect Structure:=True, Windows:=False
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFormattingColumns:=True, AllowFormattingRows:=True
End Sub
Si j'essaye de m'expliquer :
1/ Mettre OUTIL a la place des numéros de service
2/ Prendre l'ensemble des données en A pour créer une plage nommé NUMAGENT
3/ Masquer la feuille OUTIL
4/ En B11 formule OUTIL!H2
5/ En B11 formule OUTIL!G2
6/ Sur la feuille PROPOSITIONS de A17:A40 liste déroulante avec la plage NUMAGENT
7/ Protéger la feuille
8/ Protéger le classeur
Merci 1000 fois,
Bonjour,
Je ne suis pas sur de bien comprendre mais enfin, voici le résultat :
En supposant que le fichier contenant tous les onglets se nomme Historique.xlsx
K
Je ne suis pas sur de bien comprendre mais enfin, voici le résultat :
En supposant que le fichier contenant tous les onglets se nomme Historique.xlsx
Option Explicit
'
Global Maitre As Workbook
Sub Creation_Onglets()
Dim contenu As String
Dim lig As Long, derlig As Long
With Sheets("HIST")
derlig = .Range("L" & Rows.Count).End(xlUp).Row
For lig = 2 To derlig
contenu = .Cells(lig, 12).Value
If Not contenu = "" Then
If FeuilleExiste(ThisWorkbook, contenu) Then
.Rows(lig).Copy Sheets(contenu).Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
Else
Sheets.Add
ActiveSheet.Name = contenu
.Rows(1).Copy Sheets(contenu).Range("A1")
.Rows(lig).Copy Sheets(contenu).Range("A2")
End If
End If
Next lig
End With
End Sub
'
Function FeuilleExiste(ByVal wk As Workbook, ByVal stFeuille As String) As Boolean
On Error Resume Next
FeuilleExiste = Not (wk.Sheets(stFeuille) Is Nothing)
End Function
'
Sub SaveOnglet()
Dim ws As Worksheet
Dim newWk As Workbook
Dim NomFle As String
Workbooks("Historique.xlsm").Activate
Set Maitre = ActiveWorkbook
For Each ws In Worksheets
Set newWk = Workbooks.Add(xlWBATWorksheet)
ws.Copy newWk.Sheets(1)
NomFle = ActiveSheet.Name
Manipulation NomFle
ActiveWorkbook.Save
newWk.Close
Set newWk = Nothing
Maitre.Activate
Next ws
End Sub
'
Sub Manipulation(ByVal pNomFle As String)
ActiveWorkbook.SaveAs ("H" & pNomFle & ".xlsx")
Sheets(pNomFle).Select
Sheets(pNomFle).Name = "OUTIL"
Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
ActiveWorkbook.Names.Add Name:="NUMAGENT", RefersToR1C1:="=OUTIL!R2C2:R100C1"
Sheets("OUTIL").Select
ActiveWindow.SelectedSheets.Visible = False
Windows("Modele.xlsx").Activate
Sheets("PROPOSITIONS").Select
Sheets("PROPOSITIONS").Copy Before:=Workbooks("H" & pNomFle & ".xlsx").Sheets(2)
Range("B11").Select
ActiveCell.FormulaR1C1 = "=OUTIL!R[-9]C[6]"
Range("E11").Select
ActiveCell.FormulaR1C1 = "=OUTIL!R[-9]C"
Range("A17:A40").Select
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=NUMAGENT"
.IgnoreBlank = True
.InCellDropdown = True
.ShowInput = True
.ShowError = True
End With
Range("A17").Select
ActiveWorkbook.Protect Structure:=True, Windows:=False
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFormattingColumns:=True, AllowFormattingRows:=True
End Sub
K
