Vba code erreur ligne 13

[plop]

Bonjour. J aimerai pouvoir mettre à jour un code Vba d'une macro qui date de 2006 et qui ne marche pas pour faire des badges via publipostage word...mais le big dans ces macros est selon le correcteur :
**-----> For i = ligneCible To (ligneCible + nbPers)
En fait dans une feuille de mon classeur mon tableau de repas avec des quantité de personnes et des horaires midi,et soir sont à recopier autant de fois par le nombre de personne dans le feuillet à côté pour un publipostage word.
C est la requête qui n est pas juste car les coordonnées sont bonnes...je ne suis pas du tout excellente mais j aimerais bien comprendre et pouvoir y arriver...pouvez vous me donner des astuces et me dire si cela est possible...

merci beaucoup pour votre précieuse aide



Sub Badges()
'
' Badges Macro
' Macro enregistrée le 09/04/2008 par *
'
' Touche de raccourci du clavier: Ctrl+Maj+B
'
***Range("A4:K4").Select
***ActiveWindow.ScrollRow = 2
***ActiveWindow.ScrollRow = 4
***ActiveWindow.ScrollRow = 8
***ActiveWindow.ScrollRow = 12
***ActiveWindow.ScrollRow = 17
***ActiveWindow.ScrollRow = 25
***ActiveWindow.ScrollRow = 34
***ActiveWindow.ScrollRow = 43
***ActiveWindow.ScrollRow = 55
***ActiveWindow.ScrollRow = 68
***ActiveWindow.ScrollRow = 82
***ActiveWindow.ScrollRow = 95
***ActiveWindow.ScrollRow = 107
***ActiveWindow.ScrollRow = 118
***ActiveWindow.ScrollRow = 130
***ActiveWindow.ScrollRow = 144
***ActiveWindow.ScrollRow = 159
***ActiveWindow.ScrollRow = 171
***ActiveWindow.ScrollRow = 186
***ActiveWindow.ScrollRow = 201
***ActiveWindow.ScrollRow = 215
***ActiveWindow.ScrollRow = 229
***ActiveWindow.ScrollRow = 244
***ActiveWindow.ScrollRow = 258
***ActiveWindow.ScrollRow = 271
***ActiveWindow.ScrollRow = 281
***ActiveWindow.ScrollRow = 289
***ActiveWindow.ScrollRow = 294
***ActiveWindow.ScrollRow = 298
***ActiveWindow.ScrollRow = 303
***ActiveWindow.ScrollRow = 309
***ActiveWindow.ScrollRow = 318
***ActiveWindow.ScrollRow = 326
***ActiveWindow.ScrollRow = 334
***ActiveWindow.ScrollRow = 340
***ActiveWindow.ScrollRow = 346
***ActiveWindow.ScrollRow = 349
***ActiveWindow.ScrollRow = 352
***ActiveWindow.ScrollRow = 355
***ActiveWindow.ScrollRow = 357
***ActiveWindow.ScrollRow = 359
***ActiveWindow.ScrollRow = 361
***ActiveWindow.ScrollRow = 364
***ActiveWindow.ScrollRow = 369
***ActiveWindow.ScrollRow = 373
***Range("A4:K400").Select
***Application.CutCopyMode = False
***Selection.Copy
***ActiveWindow.SmallScroll Down:=-39
***ActiveWindow.ScrollRow = 332
***ActiveWindow.ScrollRow = 329
***ActiveWindow.ScrollRow = 324
***ActiveWindow.ScrollRow = 319
***ActiveWindow.ScrollRow = 310
***ActiveWindow.ScrollRow = 300
***ActiveWindow.ScrollRow = 289
***ActiveWindow.ScrollRow = 278
***ActiveWindow.ScrollRow = 265
***ActiveWindow.ScrollRow = 253
***ActiveWindow.ScrollRow = 240
***ActiveWindow.ScrollRow = 226
***ActiveWindow.ScrollRow = 211
***ActiveWindow.ScrollRow = 198
***ActiveWindow.ScrollRow = 184
***ActiveWindow.ScrollRow = 171
***ActiveWindow.ScrollRow = 159
***ActiveWindow.ScrollRow = 150
***ActiveWindow.ScrollRow = 142
***ActiveWindow.ScrollRow = 134
***ActiveWindow.ScrollRow = 126
***ActiveWindow.ScrollRow = 117
***ActiveWindow.ScrollRow = 108
***ActiveWindow.ScrollRow = 100
***ActiveWindow.ScrollRow = 91
***ActiveWindow.ScrollRow = 81
***ActiveWindow.ScrollRow = 73
***ActiveWindow.ScrollRow = 64
***ActiveWindow.ScrollRow = 55
***ActiveWindow.ScrollRow = 48
***ActiveWindow.ScrollRow = 43
***ActiveWindow.ScrollRow = 39
***ActiveWindow.ScrollRow = 35
***ActiveWindow.ScrollRow = 31
***ActiveWindow.ScrollRow = 29
***ActiveWindow.ScrollRow = 26
***ActiveWindow.ScrollRow = 23
***ActiveWindow.ScrollRow = 21
***ActiveWindow.ScrollRow = 19
***ActiveWindow.ScrollRow = 18
***ActiveWindow.ScrollRow = 17
***ActiveWindow.ScrollRow = 15
***ActiveWindow.ScrollRow = 14
***ActiveWindow.ScrollRow = 12
***ActiveWindow.ScrollRow = 10
***ActiveWindow.ScrollRow = 9
***ActiveWindow.ScrollRow = 5
***ActiveWindow.ScrollRow = 2
***ActiveWindow.ScrollRow = 1
***Sheets("Récap repas").Select
***Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
*******:=False, Transpose:=False
***Application.CutCopyMode = False
***Selection.Borders(xlDiagonalDown).LineStyle = xlNone
***Selection.Borders(xlDiagonalUp).LineStyle = xlNone
***With Selection.Borders(xlEdgeLeft)
*******.LineStyle = xlContinuous
*******.Weight = xlThin
*******.ColorIndex = xlAutomatic
***End With
***With Selection.Borders(xlEdgeTop)
*******.LineStyle = xlContinuous
*******.Weight = xlThin
*******.ColorIndex = xlAutomatic
***End With
***With Selection.Borders(xlEdgeBottom)
*******.LineStyle = xlContinuous
*******.Weight = xlThin
*******.ColorIndex = xlAutomatic
***End With
***With Selection.Borders(xlEdgeRight)
*******.LineStyle = xlContinuous
*******.Weight = xlThin
*******.ColorIndex = xlAutomatic
***End With
***With Selection.Borders(xlInsideVertical)
*******.LineStyle = xlContinuous
*******.Weight = xlThin
*******.ColorIndex = xlAutomatic
***End With
***With Selection.Borders(xlInsideHorizontal)
*******.LineStyle = xlContinuous
*******.Weight = xlThin
*******.ColorIndex = xlAutomatic
***End With
***Selection.Borders(xlDiagonalDown).LineStyle = xlNone
***Selection.Borders(xlDiagonalUp).LineStyle = xlNone
***With Selection.Borders(xlEdgeLeft)
*******.LineStyle = xlContinuous
*******.Weight = xlMedium
*******.ColorIndex = xlAutomatic
***End With
***With Selection.Borders(xlEdgeTop)
*******.LineStyle = xlContinuous
*******.Weight = xlMedium
*******.ColorIndex = xlAutomatic
***End With
***With Selection.Borders(xlEdgeBottom)
*******.LineStyle = xlContinuous
*******.Weight = xlMedium
*******.ColorIndex = xlAutomatic
***End With
***With Selection.Borders(xlEdgeRight)
*******.LineStyle = xlContinuous
*******.Weight = xlMedium
*******.ColorIndex = xlAutomatic
***End With
***With Selection.Borders(xlInsideVertical)
*******.LineStyle = xlContinuous
*******.Weight = xlThin
*******.ColorIndex = xlAutomatic
***End With
***With Selection.Borders(xlInsideHorizontal)
*******.LineStyle = xlContinuous
*******.Weight = xlThin
*******.ColorIndex = xlAutomatic
***End With
***End Sub
***Sub copie_badges()
'
' copie_badges Macro
' Macro enregistrée le 29/04/2006
'

'
Dim ligneSource, ligneCible, nbPers

ligneCible = 2

For ligneSource = 2 To 200

***Sheets("Récap repas").Select
***nbPers = Range("C" & ligneSource).Value
***Range("A" & ligneSource & ":K" & ligneSource).Select
***Selection.Copy
***Sheets("Liste badges").Select

**-----> For i = ligneCible To (ligneCible + nbPers)

*******Range("A" & i).Select
*******ActiveSheet.Paste

***Next i

***ligneCible = ligneCible + nbPers

Next ligneSource
End Sub

 

[Roland_M]

Re : Vba code erreur ligne 13

re

tu ne dis pas si tu as fais avec F8 (pas à pas) ?
tu aurais dû avoir le déclenchement du traitement d'erreur !
l'endroit ou ça pourrait coincer c'est ici > NbrPers = Range("C" & LigSource).Value
il est fort possible que ce ne soit pas du numérique !?
mais ça ne fais pas planter excel ! tu aurais dû avoir la boite de dialogue 'erreur'

 

[Roland_M]

Re : Vba code erreur ligne 13

re

si tu veux bien reprendre celui-ci, de plus il y a une erreur de ma faute dans une variable !
ici > j'avais laissé LigneCible = 2 alors que c'est LigCible1 = 2
donc là évidemment ça cause une erreur (excuses moi)

Sub Copie_Badges()
On Error GoTo TraitErreur: Err.Clear
Dim LigSource As Long, LigCible1 As Long, LigCible2 As Long, NbrPers As Long
LigCible1 = 2
For LigSource = 2 To 200
 'init
  NbrPers = Sheets("Récap repas").Range("C" & LigSource).Value
  LigCible2 = LigCible1 + NbrPers - 1
  AdresDestin$ = Range(Cells(LigCible1, "A"), Cells(LigCible2, "K")).Address
  'copi
  Sheets("Récap repas").Range("A" & LigSource & ":K" & LigSource).Copy Destination:=Sheets("Liste badges").Range(AdresDestin$)
  Application.CutCopyMode = False
 'incrémente
  LigCible1 = LigCible2 + 1
Next

'fin quitte
On Error GoTo 0: Err.Clear: Exit Sub

TraitErreur: 'traitement d'erreurs avec description
Msg$ = "Erreur " & Err.Source & "  No " & Err.Number & vbLf & vbLf & Err.Description
MsgBox Msg$, vbCritical, "", Err.HelpFile, Err.HelpContext
On Error GoTo 0: Err.Clear: Exit Sub
End Sub

 

[plop]

Re : Vba code erreur ligne 13

ouf et merci de m'avoir remis dans la discussion...et ci joint une copie du fichier en esperant que vous pourrez m aider et me donner vos meilleurs conseils...

 

[plop]

Re : Vba code erreur ligne 13

en fait il s agit de reprendre les infos de recap repas autant de ligne que le nombre de personnes pour ensuite s'en servir pour le publipostage avec word...c001 nom 60 lignes avec les indications horaires repas jour...cela permet de faire des étiquettes que l'on colle sur les badges pour la restauration par groupe. merci Roland pour vos messages ainsi que Misange et FredO

 

[Roland_M]

Re : Vba code erreur ligne 13

bonjour,

je regarde à ton classeur et j'y incorpore ma routine qui fonctionne et je le renvoie !

mais l'erreur vient bien de tes données !
For LigSource = 2 < ceci n'est pas la bonne ligne ! ce sont les titres ! c'est 4 !

à tout à l'heure !

EDIT j'ai rectifié ! il s'agit de LigSource

 

[Misange]

Re : Vba code erreur ligne 13

J'avoue ne rien comprendre : tes deux tableaux sont identiques ??
Si c'est le problème des lignes vides du premier qui te dérange, tu peux dans ton publipostage trier ta liste pour les supprimer (ou ne pas les mettre dans le premier tableau au moment du remplissage puisque tu le fais manuellement et de préférence sans formule.

 

[Roland_M]

Re : Vba code erreur ligne 13

bonjour à tous,

salut à toi Misange !

voir ci-joint si c'est bien ton souhait !?

 

[plop]

Re : Vba code erreur ligne 13

Roland M Chapeau Monsieur je suis comblée c'est exactement cela...bravo vous m'avez comprise et satisfaite...encore chapeau et grand merci...c'est top