repeter une partie de macro différemment (incrémentée)

[tecroc84]

Bonjour a toutes et tous .
j'aurais besoin de votre aide sur un problème de répétition dans la macro suivante:


Rows("362:362").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Rows("291:291").Select
Selection.Copy
Rows("362:362").Select
ActiveSheet.Paste

Rows("458:458").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Rows("387:387").Select
Selection.Copy
Rows("458:458").Select
ActiveSheet.Paste

comme vous pouvez le voir sur les partie 1 et 2 la différence se fait toutes les 96 lignes
je dois faire repeter celle ci 240 fois (jusqu'a la lignes 24000 environ )
ma question est la suivante : comment faire cette manip en une seule fois (si c'est possible)
je remercie d'avance toutes celles et ceux qui me viendront en aide.
Cordialement David.

 

[job75]

Bonjour tecroc84, bienvenue sur XLD,

Puisque vous ne joignez pas de fichier (lisez la Charte du forum) juste quelques conseils.

Il suffit de faire une boucle du type For i = fin To 362 Step -n avec fin et n à remplacer par les nombres adéquats.

En effet puisqu'à chaque fois vous insérez une ligne il faut commencer par la fin.

Pour le copier-coller utilisez la méthode a.Copy b c'est plus rapide.

Et n'utilisez pas de Select, ils sont inutiles et ralentissent la macro.

A+

 

[tecroc84]

Merci beaucoup pour votre réponse rapide Job75 je n'est pas mis le reste de la macro car cela n'a rien a voir avec cette partie mais s'il la faut dorénavant je la joindrai.
je vais essayer ce que vous m'avez donné comme solution et je vous tiens au courant.
cordialement David

 

[tecroc84]

rebonjour ,
J'ai oublié de préciser que je débute en macro donc allez y doucement svp
j'ai rentré la ligne de commande suivante (For i=22420 To 3 Step -96 Next ) sans les parenthèses mais cela ne donne rien .
je joint mon fichier et vous explique ce que je voudrais :
la ligne 3 celle avec la date doit se répéter sur tous les versos
donc il faut que j’insère une ligne au dessus de la 74 (a sa place réellement)
malheureusement la troisième ligne change sur tous les rectos suivant donc je suis obligé de répéter
chaque troisième ligne sur chaque versos suivant
cette opération se répète donc toutes les 96 lignes pour la création des lignes et toutes les 71 lignes pour le copié collé pouvez vous me donner une ligne de commande pouvant exécuter cette opération rapidement
et non pas comme j'ai commencé a faire en répétant l’opération 240 fois
Merci d'avance .
Cordialement

 

[tecroc84]

Oupps Désolé pour le fichier en triple

 

[job75]

Bonsoir,

Je rentre de soirée.

On se demande bien pourquoi il faut s'intéresser à la ligne 74 plutôt qu'à une autre mais bon...

A exécuter sur le fichier du post #4 :

Sub Insertion()
Dim i&
Application.ScreenUpdating = False  'pour accélérer
With Sheets("Feuil1")
  For i = 3304 To 74 Step -95
    .Rows(i).Insert
    .Rows(i - 71).Copy .Rows(i)
  Next
End With
End Sub

La macro ne doit servir qu'une seule fois.

Bonne nuit.

 

[tecroc84]

Bonjour,
J’espère que tu t'est bien amusé a ta soirée .
Ton code marche du tonnerre , et pour ça je te remercie infiniment.
Maintenant que cela fonctionne , je voudrais pas abuser mais j'ai besoin de reproduire
la mise en page de la page 1 (recto , verso ) sur toutes les autres pages (236 au total)
que ce soit l’entête le pied de page et l'encadrement . Mais ce n'est pas le plus important.
Merci beaucoup .

ps :comment mettre le sujet résolu ?

 

[tecroc84]

Au fait la ligne 74 c'est le début du verso de la page 1 la ou doit se coller la troisième ligne
et ainsi de suite pour les pages suivantes

 

[job75]

Bonjour tecroc84,

Puisque vous parlez de recto-verso c'est qu'il s'agit d'imprimer.

Alors pourquoi ne pas imprimer sur une seule page ???

Voyez ces 2 macros, pour imprimer activez les lignes des .PrintOut :

Sub Imprimer_Tout()
Dim i&
With Sheets("Feuil1")
  .PageSetup.FitToPagesWide = 1
  .PageSetup.FitToPagesTall = 1
  i = 1
  While .Cells(i, 1) <> ""
    .PageSetup.PrintArea = .Cells(i, 1).Resize(95, 14).Address '.Resize(88, 14) si l'on veut s'arrêter au Total
    .PrintPreview 'uniquement pour tester
    '.PrintOut 'pour imprimer
    i = i + 95
  Wend
End With
End Sub

Sub Imprimer_Partie()
Dim cherche$, c As Range, i&
With Sheets("Feuil1")
  Do
    cherche = InputBox("Nom (en partie ou totalité) ou n° du matricule :", "Recherche", cherche)
    If cherche = "" Then Exit Sub
    Set c = .[A:N].Find(cherche, , xlValues, xlPart)
    If Not c Is Nothing Then i = c.Row
  Loop While i Mod 95 <> 1
  .PageSetup.FitToPagesWide = 1
  .PageSetup.FitToPagesTall = 1
  .PageSetup.PrintArea = .Cells(i, 1).Resize(95, 14).Address '.Resize(88, 14) si l'on veut s'arrêter au Total
  .PrintPreview 'pour tester
  '.PrintOut 'pour imprimer
End With
End Sub

A+

 

[tecroc84]

Il me faut obligatoirement mes 236 pages car elle représente chacune un salarié
donc une page pour chacun a distribuer

 

[job75]

Re,

Il me faut obligatoirement mes 236 pages car elle représente chacune un salarié
donc une page pour chacun a distribuer

C'est exactement ce que fait ma macro Imprimer_Tout, une feuille papier par salarié imprimée au recto.

Bonne nuit.

 

[tecroc84]

Salut

Oui j'ai compris après ce que tu voulais dire par imprimer tout. J'ai essayé de mettre à la suite mais ça n'a pas fonctionné. J'ai du faire quelque chose de travers

Je regarde ça demain matin.

Bonne nuit

 

[job75]

Re,

La macro Imprimer_Tout ne doit être à la suite de rien du tout, elle imprime c'est tout.

A+

 

[tecroc84]

rebonjour,
je suis désolé , j'ai testé la macro seule cela me met sur 2 page et je ne sais pas pourquoi
cela me fais buguer excel a chaque essai (obligé de tout fermer par le gestionnaire de taches)
J'ai utilisé la macro suivante qui fonctionne comme je suppose que vous vouliez afficher les pages
sauf que cela me donne toujours une pages vide entre chaque pages voulu.
Je pense que l'on doit pouvoir raccourcir et arranger tout ça mais étant novice je me sers beaucoup de l'enregistrement
pour créer des macros et la je sèche.
Cordialement.


Sub lmn()
'
' lmn Macro
'

Columns("K:M").Select
Range("M1").Activate
Selection.Delete Shift:=xlToLeft
'

' miseenpages1 Macro
'
ActiveSheet.PageSetup.CenterHeader = "&BCloture de cycle CR du 29 Aout au 20 Novembre 2016&B"
ActiveSheet.PageSetup.RightFooter = "&B&D&B"
ActiveSheet.PageSetup.CenterFooter = " "
ActiveSheet.PageSetup.LeftFooter = " "

'
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
Application.PrintCommunication = True
ActiveSheet.PageSetup.PrintArea = ""
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = "&BCloture de cycle CR du 29 Aout au 20 Novembre 2016&B"
.RightHeader = ""
.LeftFooter = " "
.CenterFooter = " "
.RightFooter = "&B&D&B"
.LeftMargin = Application.InchesToPoints(0.354330708661417)
.RightMargin = Application.InchesToPoints(0.15748031496063)
.TopMargin = Application.InchesToPoints(0.708661417322835)
.BottomMargin = Application.InchesToPoints(0.393700787401575)
.HeaderMargin = Application.InchesToPoints(0.15748031496063)
.FooterMargin = Application.InchesToPoints(0.275590551181102)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintSheetEnd
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlOverThenDown
.BlackAndWhite = False
.Zoom = 74

End With
Application.PrintCommunication = True


End Sub

 

[job75]

Bonjour tecroc84,

Au temps pour moi !!!

Pour pouvoir imprimer ce qui concerne un salarié sur une seule page il faut préalablement mettre le Zoom d'impression à False :

Sub Imprimer_Tout()
Dim i&
With Sheets("Feuil1")
  .PageSetup.Zoom = False
  .PageSetup.FitToPagesWide = 1
  .PageSetup.FitToPagesTall = 1
  i = 1
  While .Cells(i, 1) <> ""
    .PageSetup.PrintArea = .Cells(i, 1).Resize(95, 14).Address '.Resize(88, 14) si l'on veut s'arrêter au Total
    .PrintPreview 'uniquement pour tester
    '.PrintOut 'pour imprimer
    i = i + 95
  Wend
End With
End Sub

Sub Imprimer_Partie()
Dim cherche$, c As Range, i&
With Sheets("Feuil1")
  Do
    cherche = InputBox("Nom (en partie ou totalité) ou n° du matricule :", "Recherche", cherche)
    If cherche = "" Then Exit Sub
    Set c = .[A:N].Find(cherche, , xlValues, xlPart)
    If Not c Is Nothing Then i = c.Row
  Loop While i Mod 95 <> 1
  .PageSetup.Zoom = False
  .PageSetup.FitToPagesWide = 1
  .PageSetup.FitToPagesTall = 1
  .PageSetup.PrintArea = .Cells(i, 1).Resize(95, 14).Address '.Resize(88, 14) si l'on veut s'arrêter au Total
  .PrintPreview 'pour tester
  '.PrintOut 'pour imprimer
End With
End Sub

Fichier joint.

A+