superbog
XLDnaute Occasionnel
Bonsoir,
J'ai un petit problème sur une longue macro correspondant à un fichier plutôt volumineux donc pas facile de sortir un fichier test
j'espère que ce sera facile pour vous, moi je galère, il me dit à la fin que j'ai next sans for alors qu'il y a bien un for...
please help
J'ai un petit problème sur une longue macro correspondant à un fichier plutôt volumineux donc pas facile de sortir un fichier test
j'espère que ce sera facile pour vous, moi je galère, il me dit à la fin que j'ai next sans for alors qu'il y a bien un for...
please help
Code:
Sub creer_feuilles_non_archivées_2015()
Dim dL, lig As Integer 'déclare la variable dl (Dernire Ligne)
Dim i As Integer 'déclare la variable i (Incrément)
Dim o As Object 'déclare la variable o (Onglet)
Dim dossier As String
Application.ScreenUpdating = False 'masque les changements à l'ecran
With Sheets("Clients") 'prend en compte l'onglet "Clients"
dL = .Cells(Application.Rows.Count, 1).End(xlUp).Row 'définit la dernière ligne éditée de la colonne 1 (=A)
For i = 2 To dL 'boucle des lignes 2 à dl
If .Cells(i, 15).Value = "A" Then GoTo suivant 'si la cellule de la boucle en colonne 15 est "A", va à l'étiquette "suivant"
On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante)
Set o = Sheets(CStr(.Cells(i, 1).Value)) 'définit l'onglet o (génère une erreur si c'est onglet n'existe pas)
If Err <> 0 Then 'condition : si une erreur a été générée
Err = 0 'annule l'erreur
'Copie le modele et on le place à la fin
Sheets("modele").Visible = True
Worksheets("Modele").Copy After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = .Cells(i, 1)
Sheets("modele").Visible = False
Sheets("clients").Activate
'Recherche de la ligne et tri dans chaque feuille
dossier = Cells(i, 1).Text
lig = Sheets(dossier).Range("A2").End(xlUp).Row
'Copie
Sheets("clients").Range("A" & i & ":P" & i).Copy Destination:=Worksheets(dossier).Range("A2")
'solde année N-1 selon que débiteur ou créditeur
If Sheets("clients").Range("S" & i) < 0 Then
Sheets("clients").Range("S" & i).Copy Destination:=-Worksheets(dossier).Range("C4")
Else: Sheets("clients").Range("S" & i).Copy Destination:=Worksheets(dossier).Range("B4")
End If
Sheets("clients").Range("T" & i & ":U" & i).Copy Destination:=Worksheets(dossier).Range("D4")
'récap années précédentes
Sheets("clients").Range("v" & i & ":w" & i).Copy Destination:=Worksheets(dossier).Range("V2")
Sheets("clients").Range("x" & i & ":y" & i).Copy Destination:=Worksheets(dossier).Range("V3")
Sheets("clients").Range("z" & i & ":aa" & i).Copy Destination:=Worksheets(dossier).Range("V4")
Sheets("clients").Range("ab" & i & ":ac" & i).Copy Destination:=Worksheets(dossier).Range("V5")
'récap forfait
Sheets("clients").Range("q" & i & ":r" & i).Copy Destination:=Worksheets(dossier).Range("f4")
'récap pb honos
Sheets("clients").Range("af" & i).Copy Destination:=Worksheets(dossier).Range("Q2")
'indique la date de création
' Worksheets(dossier).Range("C6") = Date
End If 'fin de la condition
On Error GoTo 0 'annule la gestion des erreurs
suivant: 'étiquette
If MsgBox("on continue", vbYesNo) <> vbYes Then
Exit Sub
Next i 'prochaine ligne de la boucle
End With 'fin de la pise en compte de l'onglet "Clients"
Application.ScreenUpdating = True 'affiche les changements à l'écran
MsgBox "nouveaux dossiers créés"
End Sub