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

[FCMLE44]

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

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

 

[Hasco]

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.

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

 

[FCMLE44]

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.

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]

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]

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.

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]

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.

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 :

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