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

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...

thoch63

XLDnaute Nouveau

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
1637923656139.png
 
Dernière édition:

cp4

XLDnaute Barbatruc
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
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.
 

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 ! :)
 

cp4

XLDnaute Barbatruc
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 ! :)
Content pour toi. Il ne te reste plus qu'à cliquer sur la solution (à droite du message).
 

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
 

thoch63

XLDnaute Nouveau
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
Merci beaucoup :)
 

Phil69970

XLDnaute Barbatruc
Re

@cp4 :

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

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

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.
1638200577863.png


@Phil69970
 

Discussions similaires

Statistiques des forums

Discussions
311 720
Messages
2 081 899
Membres
101 834
dernier inscrit
Jeremy06510