PDA

View Full Version : Code error 9. Create a workbook and worksheets in relation with variables



Àl'aideSVP
01-24-2017, 07:44 AM
Hi, i am new to excel VBA and my boss is asking me to create before friday something to manage a lot of variables. I will be here often to ask for your help this week and i hope you will be there for me. I will help if i can those who are in need in return. Thanks in advance.
Voici mon premier problème:

I have a code 9 error wich i manage this way:



errhandler:
Select Case Err.Number
Case 9
Sheets.Add after:=Sheets(Sheets.Count)
ActiveSheet.Name = varProvince
Call Module2.Macro3
Range("a3").Select
If activecell.Offset(1, 0) <> "" Then
Selection.End(xlDown).Select
End If
activecell.Offset(1, 0).Select

Resume

Case Else

End Select

-------------------

What i want to do ;
create in the same procedure a workbook for each varDepart et in wich create a sheet for each varUnstructu related to each varDepart.
Let me explain: each varunStructu = sector in a shop.
varDepart = department in the same shop.

there is a formula to give a department to each sector in the data base.
each departement as a lot of sector et i need to create a workbook for each departement(varDepart) with a sheet for each sector(varUnStructu) related to the departement.


ex: if The Assembly department as 3 sectors AAA, BBB and CCC
i need a worksheet with 3 sheets named AAA BBB and CCC.

i need this for all varDepart and all varUnstructu


Here is my entire Sub for now:


Sub Employe_par_secteur()

On Error GoTo errhandler

Application.ScreenUpdating = False

Dim varMat As Long
Dim varNom As String
Dim varAnnee As Long
Dim varJours As Long
Dim varPrio As Long
Dim varFonction As String
Dim varUnStructu As String
Dim varQuart As String
Dim varDepart As String




Sheets("Feuil1").Select
Range("a3").Select
If ActiveCell.Offset(1, 0) <> "" Then
Selection.End(xlDown).Select
End If
ActiveCell.Offset(1, 0).Select

Sheets("liste employés").Select
Range("a2").Select

Do While ActiveCell <> ""


varMat = Trim(ActiveCell)
varNom = Trim(ActiveCell.Offset(0, 1))
varAnnee = Trim(ActiveCell.Offset(0, 2))
varJours = Trim(ActiveCell.Offset(0, 3))
varPrio = Trim(ActiveCell.Offset(0, 4))
varFonction = Trim(ActiveCell.Offset(0, 5))
varUnStructu = Trim(ActiveCell.Offset(0, 6))
varQuart = Trim(ActiveCell.Offset(0, 7))
varDepart = Trim(ActiveCell.Offset(0, 12))




Workbooks(varDepart).Select
ActiveCell = varMat
ActiveCell.Offset(0, 1) = varNom
ActiveCell.Offset(0, 2) = varAnnee
ActiveCell.Offset(0, 3) = varJours
ActiveCell.Offset(0, 4) = varPrio
ActiveCell.Offset(0, 5) = varFonction
ActiveCell.Offset(0, 6) = varUnStructu
ActiveCell.Offset(0, 7) = varQuart
ActiveCell.Offset(1, 0).Select
Sheets("liste employés BRP").Select


ActiveCell.Offset(1, 0).Select

Loop

Exit Sub

errhandler:
Select Case Err.Number
Case 9
Sheets.Add after:=Sheets(Sheets.Count)
ActiveSheet.Name = varUnStructu
Call Module2.Macro3
Range("a3").Select
If activecell.Offset(1, 0) <> "" Then
Selection.End(xlDown).Select
End If
activecell.Offset(1, 0).Select

Resume

Case Else

End Select

Application.ScreenUpdating = True

End Sub



thanks for helping !

SamT
01-24-2017, 01:33 PM
So you have one sheet with a complete list of employees.

From that list, create Department Workbooks with Sector Worksheets and fill the Sector sheets with lists of Sector Employees

Is that correct?

Do you have more than 10,000 employees?

Required Functions

Private Function WorkbookIsOpen(DeptName As String) As Boolean
Dim wb As Workbook

On Error Resume Next
Set wb = Workbooks(DeptName & ".xlsx")
If Err = 0 Then
WorkbookIsOpen = True
Else: WorkbookIsOpen = False
End If
End Function


Function WorkSheetExists(SectorName As String, DeptName As String ) As Boolean
Dim ws As Worksheet, wb As Workbook

On Error GoTo NotExists
Set wb = Workbooks(DeptName & ".xlsx") ) Workbooks(DeptName & ".xlsx")
Set ws = wb.Worksheets(SectorName)
WorkSheetExists = True
Exit Function
notExists:
WorkSheetExists = False
End Function

SamT
01-24-2017, 01:46 PM
Do not start another thread inre this question