Vba code erreur ligne 13

  • Initiateur de la discussion Initiateur de la discussion plop
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

plop

XLDnaute Nouveau
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
 
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'
 
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)

Code:
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
 
Dernière édition:
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
 
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
 
Dernière édition:
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.
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

  • Question Question
XL pour MAC Recherche date
Réponses
5
Affichages
2 K
Réponses
8
Affichages
894
Réponses
13
Affichages
3 K
Réponses
2
Affichages
849
Retour