Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Microsoft 365 Répétition macro sur nombre de lignes X

T

thoch63

XLDnaute Nouveau
Bonjour à tous ;

J'aurai besoin de votre expertise pour réaliser une macro Excel

Je dois répéter ma macro sur 350 lignes, savez vous quelle code mettre pour que ma macro en automatique aille chercher ligne par ligne ?

Voici mon code macro:




Sub Macrotesttemplate()
'
' Macrotesttemplate Macro
'

'
Range("A2").Select
Selection.Copy
Sheets("TEMPLATE 1").Select
ActiveWindow.SmallScroll Down:=9
Range("B22").Select
ActiveSheet.Paste
Sheets("Sheet1").Select
Range("B2").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("TEMPLATE 1").Select
Range("B23").Select
ActiveSheet.Paste
Sheets("Sheet1").Select
Range("C2").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("TEMPLATE 1").Select
ActiveWindow.SmallScroll Down:=-21
Range("B3").Select
ActiveSheet.Paste
Sheets("Sheet1").Select
Range("D2").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("TEMPLATE 1").Select
Range("B8").Select
ActiveSheet.Paste
Sheets("Sheet1").Select
Range("E2").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("TEMPLATE 1").Select
Range("B11").Select
ActiveSheet.Paste
Sheets("Sheet1").Select
Range("F2").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("TEMPLATE 1").Select
Range("B10").Select
ActiveSheet.Paste
Sheets("Sheet1").Select
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 3
Range("G2").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("TEMPLATE 1").Select
Range("B4").Select
ActiveSheet.Paste
Sheets("Sheet1").Select
Range("H2").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("TEMPLATE 1").Select
Range("B7").Select
ActiveSheet.Paste
Sheets("Sheet1").Select
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
Sheets("TEMPLATE 1").Select
Application.CutCopyMode = False
Sheets("TEMPLATE 1").Copy After:=Sheets(2)
Sheets("Sheet1").Select
Range("A3").Select
Selection.Copy
Sheets("TEMPLATE 1 (2)").Select
ActiveWindow.SmallScroll Down:=9
Range("B22").Select
ActiveSheet.Paste
Sheets("Sheet1").Select
Range("B3").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("TEMPLATE 1 (2)").Select
Range("B23").Select
ActiveSheet.Paste
ActiveWindow.SmallScroll Down:=-21
Sheets("Sheet1").Select
Range("C3").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("TEMPLATE 1 (2)").Select
Range("B3").Select
ActiveSheet.Paste
Sheets("Sheet1").Select
Range("D3").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("TEMPLATE 1 (2)").Select
Range("B8").Select
ActiveSheet.Paste
Sheets("Sheet1").Select
Range("E3").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("TEMPLATE 1 (2)").Select
Range("B11").Select
ActiveSheet.Paste
Sheets("Sheet1").Select
Range("F3").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("TEMPLATE 1 (2)").Select
Range("B10").Select
ActiveSheet.Paste
Sheets("Sheet1").Select
Range("G3").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("TEMPLATE 1 (2)").Select
Range("B4").Select
ActiveSheet.Paste
Sheets("Sheet1").Select
Range("H3").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("TEMPLATE 1 (2)").Select
Range("B7").Select
ActiveSheet.Paste
End Sub




Merci à tous !
 
Solution
Re,
@Phil69970
@thoch63 : Je partage l'avis de Phil69970. En effet, le code ci-dessous plantera au-delà de 255 onglets.
VB: 
Option Explicit

Sub Macrotesttemplate()
    Dim i As Long, dl As Long, Sh As Worksheet
    Application.DisplayAlerts = False
    'on supprime toutes les feuilles "Template.."
    For Each Sh In Worksheets
        If Sh.Name Like "Template*" Then
            Sheets(Sh.Name).Delete
        End If
    Next

    'on traite les lignes
    With Sheets("INFOS BRUTS")
        dl = .Range("A1").CurrentRegion.End(xlDown).Row

        For i = 2 To dl
            Sheets.Add(After:=Worksheets("template")).Name = "Template" & i - 1    'on ajoute et on nomme les feuilles...
Trier par date Trier par votes
T

thoch63

XLDnaute Nouveau
Vote positif 0 Vote négatif

cp4

XLDnaute Barbatruc
Re,
@Phil69970
@thoch63 : Je partage l'avis de Phil69970. En effet, le code ci-dessous plantera au-delà de 255 onglets.
VB: 
Option Explicit

Sub Macrotesttemplate()
    Dim i As Long, dl As Long, Sh As Worksheet
    Application.DisplayAlerts = False
    'on supprime toutes les feuilles "Template.."
    For Each Sh In Worksheets
        If Sh.Name Like "Template*" Then
            Sheets(Sh.Name).Delete
        End If
    Next

    'on traite les lignes
    With Sheets("INFOS BRUTS")
        dl = .Range("A1").CurrentRegion.End(xlDown).Row

        For i = 2 To dl
            Sheets.Add(After:=Worksheets("template")).Name = "Template" & i - 1    'on ajoute et on nomme les feuilles
            Sheets("template").UsedRange.Copy    'on copie la feuille template
            ActiveSheet.Range("A1").PasteSpecial Paste:=xlPasteAll    'on colle tout
            ActiveSheet.Range("A1").PasteSpecial Paste:=xlPasteColumnWidths    'on adapte la largeur

            'on recopie les cellules
            .Range("A2").Copy ActiveSheet.Range("B22")
            .Range("B2").Copy ActiveSheet.Range("B23")
            .Range("C2").Copy ActiveSheet.Range("B3")
            .Range("D2").Copy ActiveSheet.Range("B8")
            .Range("E2").Copy ActiveSheet.Range("B11")
            .Range("F2").Copy ActiveSheet.Range("B10")
            .Range("G2").Copy ActiveSheet.Range("B4")
            .Range("H2").Copy ActiveSheet.Range("B7")

        Next i
        .Activate
    End With
    Application.DisplayAlerts = True
    MsgBox "Traitement terminé!", vbInformation + vbOKOnly, "TRAITEMENT DONNEES"
End Sub
Le code supprime les feuilles, puis les recrée pour y ajouter les données. Sur ton fichier joint au post#1, le code est fonctionnel.

edit: En fin de compte le code n'a pas planté au-delà de 255 feuilles
 
Dernière édition:
Vote positif 0 Vote négatif
Solution

cp4

XLDnaute Barbatruc
Phil69970 à dit:
Re


Certes mais cela n'est pas viable d'avoir 350 onglets pour moi.

Perso je préférè cette approche :

*Merci de ton retour

@Phil69970
Cliquez pour agrandir...
En effet, c'est la meilleure solution. On ne surcharge pas le feuille pour rien.
Que veut exactement faire @thoch63 avec une collection d'onglets.

ps: j'ai poussé le champignon le code plante à la 6942ème feuille, soit 6943 feuilles pas plus.
 
Vote positif 0 Vote négatif
T

thoch63

XLDnaute Nouveau
Re @Phil69970 & @cp4

Merci tout d'abord de votre réactivité !

@cp4 Tout ces onglets sont des "fiches clients" pour un démarchage téléphonique pour mes études

Mon fichier compte aux alentours des 500 lignes sur l'onglet 'infos bruts'
Je vais donc me faire 10 fichiers de 50 lignes qui seront beaucoup plus buvable ! lol

Vos 2 solutions fonctionnent et ont résolu mon problème

Je vous en remercie !
 
Vote positif 0 Vote négatif

cp4

XLDnaute Barbatruc
Content pour toi. Il ne te reste plus qu'à cliquer sur la solution (à droite du message).
 
Vote positif 0 Vote négatif

cp4

XLDnaute Barbatruc
Re @toch63, oups! Code corrigé.
VB: 
Option Explicit

Sub Macrotesttemplate()
    Dim i As Long, dl As Long, Sh As Worksheet
    Application.DisplayAlerts = False
    'on supprime toutes les feuilles "Template.."
    For Each Sh In Worksheets
        If Sh.Name Like "Template*" Then
            Sheets(Sh.Name).Delete
        End If
    Next

    'on traite les lignes
    With Sheets("INFOS BRUTS")
        dl = .Range("A1").CurrentRegion.End(xlDown).Row

        For i = 2 To dl
            Sheets.Add(After:=Worksheets("template")).Name = "Template" & i - 1    'on ajoute et on nomme les feuilles
            Sheets("template").UsedRange.Copy    'on copie la feuille template
            ActiveSheet.Range("A1").PasteSpecial Paste:=xlPasteAll    'on colle tout
            ActiveSheet.Range("A1").PasteSpecial Paste:=xlPasteColumnWidths    'on adapte la largeur

            'on recopie les cellules
            .Range("A" & i).Copy ActiveSheet.Range("B22")
            .Range("B" & i).Copy ActiveSheet.Range("B23")
            .Range("C" & i).Copy ActiveSheet.Range("B3")
            .Range("D" & i).Copy ActiveSheet.Range("B8")
            .Range("E" & i).Copy ActiveSheet.Range("B11")
            .Range("F" & i).Copy ActiveSheet.Range("B10")
            .Range("G" & i).Copy ActiveSheet.Range("B4")
            .Range("H" & i).Copy ActiveSheet.Range("B7")

        Next i
        .Activate
    End With
    Application.DisplayAlerts = True
    MsgBox "Traitement terminé!", vbInformation + vbOKOnly, "TRAITEMENT DONNEES"
End Sub
 
Vote positif 0 Vote négatif
T

thoch63

XLDnaute Nouveau
Merci beaucoup
 
Vote positif 0 Vote négatif

Phil69970

XLDnaute Barbatruc
Re

@cp4 :

Je suis tombé sur ce lien pour un autre pb et cela m'a rappelé ta remarque :
cp4 à dit:
ps: j'ai poussé le champignon le code plante à la 6942ème feuille, soit 6943 feuilles pas plus.
Cliquez pour agrandir...

Nombre maximal de feuilles par classeurLimité par la quantité de mémoire disponible (valeur par défaut 1 feuille)

Spécifications et limites relatives à Excel - Support Microsoft

Dans Excel 2010, la taille maximale des feuilles de calcul est de 1 048 576 lignes par 16 384 colonnes. Cet article décrit les limites et spécifications des fonctionnalités, des classeurs et des feuilles de calcul.
support.microsoft.com

PS:Je maintiens que découper le fichier en petit bout de 50 onglets (feuilles) n'est pas la meilleure façon de faire et n'est pas viable dans la durée
Par exemple , je verrais mieux une colonne supplémentaire avec le nom des agents qui devront s'occuper des x clients chacun.
Chaque agent est responsable de son groupe de client avec pour avantage 1 seul fichier pour tout le monde et non pas x fichiers....qui se baladent.


@Phil69970
 
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.

Discussions similaires

G
  • Question
XL 2019 Sélectionner un fichier pour mettre à jour une base de données
Réponses
3
Affichages
173
sylvanu
  • Question
Autres fenêtre "Publication"
Réponses
10
Affichages
426
ph.vanne
H
  • Résolu(e)
XL 2016 Copier cellule dans un autre onglets
2
Réponses
16
Affichages
323
Phil69970
M
  • Question
Microsoft 365 deux macros succesives et un bouton
2
Réponses
16
Affichages
701
Phil69970
  • Résolu(e)
XL 2021 Exécuter une macro sur plusieurs feuilles
Réponses
9
Affichages
304
micie1509
R
  • Résolu(e)
XL 2019 creer une macro pour copier des info d un onglet a un autre dans le meme classeur
Réponses
4
Affichages
528
robpellan52
R
R
  • Question
XL 2010 Effacement de données dans plusieurs feuilles de calcul dans un même classeur
Réponses
3
Affichages
544
robbynasch
R
S
  • Résolu(e)
Autres ActiveWorkbook.Worksheets("vierge").AutoFilter.Sort.SortFields.Clear
2
Réponses
23
Affichages
2 K
AtTheOne
O
  • Question
XL 2010 aide sur code VBA collationnement de données
Réponses
10
Affichages
702
olivier388
O
K
  • Question
XL 2019 Organiser le code VBA
Réponses
9
Affichages
790
Kevin38
K
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…