Macro VBA Copier coller des données en utilisant une boucle

Bonjour à tous,

J’ai besoin de votre aide, svp… Je n’y connais vraiment rien en VBA et il faudrait que je crée, à partir du fichier en PJ, une macro qui puisse :

• dupliquer la feuille « Mod_vierge » afin d’y copier certaines cellules de la feuille « Données » et les coller dans la nouvelle feuille « Mod_vierge 2» (j’ai identifié les données avec des couleurs pour que ce soit plus facile à comprendre)
• donner comme nom à cette nouvelle feuille, le n° de lot qui y a été renseigné
• renouveler l’opération pour avoir autant de feuilles que de lignes présentes dans le tableau

Le nombre de lignes peut varier tous les mois, il faudrait que la macro puisse créer le nombre de feuilles nécessaires en fonction du nombre de lignes du tableau.

J’espère avoir été claire dans mes explications… Merci par avance pour votre aide 😊

Bonsoir FC19, le forum,

Une proposition...qui peut certainement être optimisée...

Cordialement,

Bonsoir à tous,

FC19, il faut bien formater les cellules d16, d17, d28 ,d29 et d30 de la feuille qui te sert de modèle.

Option Explicit
Sub duplicate()
    Dim a, i As Long
    Application.ScreenUpdating = False
    With Sheets("Données").[a1].CurrentRegion
        a = .Value
        For i = 2 To UBound(a, 1)
            If Not Evaluate("isref('" & a(i, 1) & "'!a1)") Then
                Sheets("Mod_vierge").Copy After:=Sheets(Sheets.Count)
                ActiveSheet.Name = a(i, 1)
                With Sheets(CStr(a(i, 1)))
                    .[d16] = a(i, 4): .[d17] = a(i, 5): .[d28] = a(i, 2)
                    .[d29] = a(i, 1): .[d30] = a(i, 3)
                End With
            End If
        Next
    End With
    Application.ScreenUpdating = True
End Sub

Ou celle-ci :

Sub duplicate1()
    Dim r As Range
    Application.ScreenUpdating = False
    For Each r In Sheets("Données").Cells(1).CurrentRegion.Offset(1).Columns(1).Cells
        If r <> "" Then
            If Not Evaluate("isref('" & r.Text & "'!a1)") Then
                Sheets("Mod_vierge").Copy , Sheets(Sheets.Count)
                Sheets(Sheets.Count).Name = r.Text
                With Sheets(r.Text)
                    .[d16] = r(, 4): .[d17] = r(, 5): .[d28] = r(, 2)
                    .[d29] = r(, 1): .[d30] = r(, 3)
                End With
            End If
        End If
    Next
    Application.ScreenUpdating = True
End Sub

Il serait peut-être plus judicieux de transférer les éléments demandés de la feuille "Données" vers la feuille modèle via une liste déroulante accompagnée des formules adéquates, ça t'éviterait de créer autant de feuilles que de lignes.

klin89

Un grand merci à tous les 2 pour votre aide , vos codes marchent nickel !!!

Klin89, c'est sûr que la liste déroulante aurait être beaucoup plus pratique mais ils veulent absolument des onglets séparés pour archiver... Je garde en tête ton idée si jamais.

Merci encore !

Re le forum,

Tu peux aussi choisir la facture à créer via cette procédure événementielle, à placer dans le module de la feuille ("Données")

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Not Intersect(Target, Range("A2", Range("A" & Rows.Count).End(xlUp))) Is Nothing Then
        If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub
        If Not Evaluate("isref('" & Target.Value & "'!a1)") Then
            Sheets("Mod_vierge").Copy After:=Sheets(Sheets.Count)
            ActiveSheet.Name = Target.Value
            With Sheets(CStr(Target.Value))
                .[d16] = Range("D" & Target.Row): .[d17] = Range("E" & Target.Row)
                .[d28] = Range("B" & Target.Row): .[d29] = Range("A" & Target.Row)
                .[d30] = Range("C" & Target.Row)
            End With
        End If
    End If
End Sub

klin89