Microsoft 365 Boucle For Each avec remplissage de case puis création feuille selon données

FCMLE44

XLDnaute Impliqué
Supporter XLD
Bonjour

J'ai un fichier avec une feuille nommée Fichier Origine. Pour chaque ligne à partir de la ligne 2, je souhaite que les données de cette ligne remplissent automatiquement les cases mentionnées.

Je souhaiterais aussi créer une feuille par ligne de la feuille Fichier Origine
cf modèle feuille zzzz

Pour la boucle j'ai déja mis cela. Cela crée bien les feuilles mais en Rows

Merci beaucoup

VB:
Sub Macocotte()
    Dim xRow As Long
    Dim I As Long
    With ActiveSheet
        xRow = .Range("A" & Rows.Count).End(xlUp).Row
        For I = 1 To xRow
            Worksheets.Add(, Sheets(Sheets.Count)).Name = "Row " & I
            .Rows(I).Copy Sheets("Row " & I).Range("A1")
        Next I
    End With
End Sub
 

Pièces jointes

  • test.xlsx
    22.6 KB · Affichages: 7
Solution
bonsoir,

Si j'ai bien compris, vous trouverez dans le fichier ci-joint, la macro suivante qui crée les feuilles si elles n'existent pas et renseigne les cellules, si la feuille existe déjà, les données seront mise à jours avec les valeurs de la ligne en cours de boucle.

VB:
Sub Macocotte()
 Dim ws As Worksheet
 Dim lgRow As Long
 Dim nom As String
 With ThisWorkbook.Sheets("Fichier Origine").Range("A1").CurrentRegion
    For lgRow = 2 To .Rows.Count
        nom = Trim(.Cells(lgRow, 1))
        If nom <> "" Then
            Set ws = getSheetByName(nom, True)
            If Not ws Is Nothing Then
                ws.Range("P5") = nom
                ws.Range("P6") = .Cells(lgRow, 2)
                ws.Range("D7") = .Cells(lgRow, 3)...

Hasco

XLDnaute Barbatruc
Repose en paix
bonsoir,

Si j'ai bien compris, vous trouverez dans le fichier ci-joint, la macro suivante qui crée les feuilles si elles n'existent pas et renseigne les cellules, si la feuille existe déjà, les données seront mise à jours avec les valeurs de la ligne en cours de boucle.

VB:
Sub Macocotte()
 Dim ws As Worksheet
 Dim lgRow As Long
 Dim nom As String
 With ThisWorkbook.Sheets("Fichier Origine").Range("A1").CurrentRegion
    For lgRow = 2 To .Rows.Count
        nom = Trim(.Cells(lgRow, 1))
        If nom <> "" Then
            Set ws = getSheetByName(nom, True)
            If Not ws Is Nothing Then
                ws.Range("P5") = nom
                ws.Range("P6") = .Cells(lgRow, 2)
                ws.Range("D7") = .Cells(lgRow, 3)
                ws.Range("E7") = .Cells(lgRow, 4)
                ws.Range("G7") = .Cells(lgRow, 5)
                ws.Range("J7") = .Cells(lgRow, 6)
                ws.Range("K7") = .Cells(lgRow, 7)
                ws.Range("L7") = .Cells(lgRow, 8)
            End If
        End If
    Next
 End With
End Sub

Pourquoi ne pas avoir mis votre macro ?

Pour accélérer un peu, on pourrait mettre votre tableau de 'Fichier origine' en mémoire et le parcourir mais vu le nombre de lignes cela ne vaut pas la peine (à mon avis) d'encombrer la mémoire pour rien. D'autant que la création de feuille est ce qui prend le plus de temps.

Cordialement
 

Pièces jointes

  • FCMLE44.xlsm
    53.2 KB · Affichages: 5

FCMLE44

XLDnaute Impliqué
Supporter XLD
bonsoir,

Si j'ai bien compris, vous trouverez dans le fichier ci-joint, la macro suivante qui crée les feuilles si elles n'existent pas et renseigne les cellules, si la feuille existe déjà, les données seront mise à jours avec les valeurs de la ligne en cours de boucle.

VB:
Sub Macocotte()
 Dim ws As Worksheet
 Dim lgRow As Long
 Dim nom As String
 With ThisWorkbook.Sheets("Fichier Origine").Range("A1").CurrentRegion
    For lgRow = 2 To .Rows.Count
        nom = Trim(.Cells(lgRow, 1))
        If nom <> "" Then
            Set ws = getSheetByName(nom, True)
            If Not ws Is Nothing Then
                ws.Range("P5") = nom
                ws.Range("P6") = .Cells(lgRow, 2)
                ws.Range("D7") = .Cells(lgRow, 3)
                ws.Range("E7") = .Cells(lgRow, 4)
                ws.Range("G7") = .Cells(lgRow, 5)
                ws.Range("J7") = .Cells(lgRow, 6)
                ws.Range("K7") = .Cells(lgRow, 7)
                ws.Range("L7") = .Cells(lgRow, 8)
            End If
        End If
    Next
 End With
End Sub

Pourquoi ne pas avoir mis votre macro ?

Pour accélérer un peu, on pourrait mettre votre tableau de 'Fichier origine' en mémoire et le parcourir mais vu le nombre de lignes cela ne vaut pas la peine (à mon avis) d'encombrer la mémoire pour rien. D'autant que la création de feuille est ce qui prend le plus de temps.

Cordialement
Top Merci

Est il possible de créer une autre macro qui vient à la suite pour créer un pdf global pour regrouper toutes les feuilles ainsi créées dans un seul pdf ?
 

Hasco

XLDnaute Barbatruc
Repose en paix
Re,

Euh!!!! Les questions à tiroirs, ce n'est pas pour moi.
Et conformément à la charte du forum, que je suis sûr vous avez lu : je vous recommande d'ouvrir un nouveau fil.
2.3 – Le titre de la question doit être clair et comporter explicitement le sujet de la demande. Cela sous-entend qu’une nouvelle demande fait l’objet d’un nouveau fil.
 

FCMLE44

XLDnaute Impliqué
Supporter XLD
bonsoir,

Si j'ai bien compris, vous trouverez dans le fichier ci-joint, la macro suivante qui crée les feuilles si elles n'existent pas et renseigne les cellules, si la feuille existe déjà, les données seront mise à jours avec les valeurs de la ligne en cours de boucle.

VB:
Sub Macocotte()
 Dim ws As Worksheet
 Dim lgRow As Long
 Dim nom As String
 With ThisWorkbook.Sheets("Fichier Origine").Range("A1").CurrentRegion
    For lgRow = 2 To .Rows.Count
        nom = Trim(.Cells(lgRow, 1))
        If nom <> "" Then
            Set ws = getSheetByName(nom, True)
            If Not ws Is Nothing Then
                ws.Range("P5") = nom
                ws.Range("P6") = .Cells(lgRow, 2)
                ws.Range("D7") = .Cells(lgRow, 3)
                ws.Range("E7") = .Cells(lgRow, 4)
                ws.Range("G7") = .Cells(lgRow, 5)
                ws.Range("J7") = .Cells(lgRow, 6)
                ws.Range("K7") = .Cells(lgRow, 7)
                ws.Range("L7") = .Cells(lgRow, 8)
            End If
        End If
    Next
 End With
End Sub

Pourquoi ne pas avoir mis votre macro ?

Pour accélérer un peu, on pourrait mettre votre tableau de 'Fichier origine' en mémoire et le parcourir mais vu le nombre de lignes cela ne vaut pas la peine (à mon avis) d'encombrer la mémoire pour rien. D'autant que la création de feuille est ce qui prend le plus de temps.

Cordialement
Je viens de m'apercevoir que si je supprime les feuilles présentes ou les données en A2 de la feuille Fichier Origine, ca me plante tout
Que peut on faire dans ce cas ?
 

Hasco

XLDnaute Barbatruc
Repose en paix
Bonjour,
si je supprime les feuilles présentes ou les données en A2 de la feuille Fichier Origine, ca me plante tout

Les autres feuilles que 'Fichier Origine' c'est étrange, à part pour la feuille 'Modèle' qui est reproduite.
Pour les données de la feuille 'Fichier Origine', il vous suffit de tester si la plage a plusieurs lignes
vous pouvez tester la présence de la feuille modèle également.

VB:
Sub Macocotte()
    Dim ws As Worksheet
    Dim lgRow As Long
    Dim nom As String
    With ThisWorkbook
        '
        ' Vérifier l'éxistence de la feuille 'Modèle'
        Set ws = getSheetByName("Modèle", False)
        If ws Is Nothing Then
            MsgBox "Opération interrompue : la feuille 'Modèle' n'existe pas dans le fichier", vbExclamation, "Macro : Macocotte"
            GoTo FIN
        End If
        '
        ' important pour les lignes suivantes
        ' Réinitialiser la variable à nothing
        Set ws = Nothing
        '
        ' Travailler sur la plage de lignes et colonnes contigues A1
        With .Sheets("Fichier Origine").Range("A1").CurrentRegion
        '
        ' Parcourir les lignes de la plage
            For lgRow = 2 To .Rows.Count
                '
                ' si un nom est présent en colonne 1
                nom = Trim(.Cells(lgRow, 1))
                If nom <> "" Then
                    '
                    ' voir s'il existe une feuille à ce nom,
                    ' éventuellement la créer
                    ' et ensuite mettre à jour les données.
                    Set ws = getSheetByName(nom, True)
                    If Not ws Is Nothing Then
                        ws.Range("P5") = nom
                        ws.Range("P6") = .Cells(lgRow, 2)
                        ws.Range("D7") = .Cells(lgRow, 3)
                        ws.Range("E7") = .Cells(lgRow, 4)
                        ws.Range("G7") = .Cells(lgRow, 5)
                        ws.Range("J7") = .Cells(lgRow, 6)
                        ws.Range("K7") = .Cells(lgRow, 7)
                        ws.Range("L7") = .Cells(lgRow, 8)
                    End If
                End If
            Next
        End With
    End With
FIN:
End Sub

Et puisque vous dites avoir écrit ses lignes :
Code:
Sub Macocotte()
    Dim xRow As Long
    Dim I As Long
    With ActiveSheet
        xRow = .Range("A" & Rows.Count).End(xlUp).Row
        For I = 1 To xRow
            Worksheets.Add(, Sheets(Sheets.Count)).Name = "Row " & I
            .Rows(I).Copy Sheets("Row " & I).Range("A1")
        Next I
    End With
End Sub

Vous pouvez également proposer quelque chose lorsque un iatus se présente. Participer, en somme.

cordialement
 
Dernière édition:

Discussions similaires

Réponses
2
Affichages
129

Statistiques des forums

Discussions
311 725
Messages
2 081 941
Membres
101 846
dernier inscrit
Silhabib