Code erreur 9 Créer un nouveau classeur avec feuilles en lien avec variables

[Àl'aideSVP]

Bonjour à tous, je suis un néophyte en vba et mon patron me donne jusqu'à vendredi pour créer un dossier pouvant gérer énormément de variables.
Je serai probablement ici souvent cette semaine pour vous demander de l'aide. j'espère pouvoir compter sur vous et vous remercie à l'avance.

Voici mon premier problème:

j'ai le code d'erreur 9 que je règle de la façon suivante:


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

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

ce que je veux faire ;
créer dans la même procédure un classeur par varDepart et dans chaque classeur créer une feuille par varUnStructu.

je m'explique; varDepart = département d'usine
varUnstructu = secteur d'un département.

il faut donc que dans un classeur d'un département (varDepart), tous les secteurs (varUnstructu) reliés à ce département aient une feuille attitrée à ce secteur à l'intérieur du classeur.

ex: le département assemblage a comme secteurs AAA,BBB et CCC.
je veux donc un classeur pour le département assemblage avec 3 feuilles nommées AAA, BBB et CCC
je veux donc que cela ce fasse pour toutes les varDepart et toutes les varUnStructu.

Les varDepart et varUnstructu seront liées dans la base de données ce qui veut dire que une formule permettre de donner une valeur de département(varDepart) à tous les secteurs(varUnstructu)

voici mon sub en entier pour l'instant:

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 = 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

Application.ScreenUpdating = True

End Sub

merci de m'aider!

 

[Lone-wolf]

Bonjour Àl'aideSVP et bienvenue sur XLD

Et........ Au secouououours!!

Ici Workbooks(varDepart).Select, si c'est la feuille que tu veux sélectionner alors -> Sheets(varDepart).Select, Workbooks c'est le classeur.

Change

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 BRP").Select
Range("a2").Select

Par

With Sheets(1)
.Range("a3").Copy  .Range("a4")
.Range("a4").AutoFill Destination:=.Range("a4:a65000")
End with

 

[Àl'aideSVP]

ça ne fonctionne pas, en fait cela a pour résultat de me faire passer d'un coup du End with que tu m'a fournis à end sub

donc plus rien de mon sub n'est pris en charge

 

[Lone-wolf]

Re

il faut dans ce cas mettre End With juste avant End Sub

With Sheets(1)

Toute la macro

End With
End Sub

 

[Àl'aideSVP]

non plus, ça ne génère plus de code 9 donc on ne cré plus de workbook ni de sheets.
je me sers du code d'erreur pour créer les workbook et les sheets voulues d'où le on error goto...

 

[Àl'aideSVP]

merci de tenter de m'aider en passant c'est très apprécié

 

[Lone-wolf]

Désolé, j'ai mal interpreter ta macro.

D'après ce que j'ai relu tu sélectionne toute un plage? Si c'est le cas, mieux vaut écrire comme ceci

Set plage = .Range("a4:a" & .Range("a" & Rows.count).end(xlup).row)
For each cel in plage
le code
Next cel

Sub test()

With Feuil1
.Range("a3").Activate
Set plage = .Range("a3:a" & .Range("a" & Rows.Count).End(xlUp).Row)
For Each cel In plage
If cel.Offset(1, 0) <> "" Then
cel.Offset(1, 0).Activate
End If
t = Timer + 1: Do Until Timer > t: DoEvents: Loop
Next cel
End With
End Sub