XL 2016 VBA copier ligne dans un tableau

[Yücel]

Bonjour,

Lorsque j'entre un numéro dans la cellule "C6" de l'onglet "Journal"et que je clique sur le bouton "Dupliquer", il doit aller sur l'onglet "Dupliquer" et copier
(de la colonne B à P) toutes les lignes (avec ce même numéro indiqué en "colonne A") puis me les coller en dessous du tableau en m'insérant des lignes.

Est-ce possible ?? merci pour votre aide !

Ci-joint le fichier.

Avec mes remerciements.

Bonne soirée.

 

[vgendron]

Hello
un essai avec ce code

Sub Dupliquer()

With Sheets("Dupliquer")
    fin = .Range("A" & .Rows.Count).End(xlUp).Row + 2
End With

With ActiveSheet
    Pièce = .Range("C6")
    With Range("Tableau1")
        Set zone = .Columns(2).Find(Pièce)
        If Not zone Is Nothing Then
            Set ZoneToDupliq = zone.Offset(0, -1).Resize(2, 15)
            ZoneToDupliq.Copy Destination:=Sheets("Dupliquer").Range("B" & fin)
            Sheets("Dupliquer").Range("A" & fin).Resize(2) = Pièce
        End If
    End With
End With


End Sub

 

[Yücel]

Bonjour et merci à vous !

C'est presque ça ! mais c'est fait dans l'inverse.

j'ai mis un peu plus de détail dans le fichier joint de ce que je souhaite.

 

[vgendron]

Deuxième essai

Sub Dupliquer()
Dim ZoneToFilter As Range
With ActiveSheet
    Pièce = .Range("C6")
    FinJ = .Range("B" & .Rows.Count).End(xlUp).Row + 2
End With

With Sheets("Dupliquer")
    FinDup = .Range("A" & .Rows.Count).End(xlUp).Row
    Set ZoneToFilter = .Range("A1:P" & FinDup)
    ZoneToFilter.AutoFilter
    ZoneToFilter.AutoFilter Field:=1, Criteria1:=CStr(Pièce)
    'NbLignesFiltrée = ZoneToFilter.Resize(, 1).SpecialCells(xlCellTypeVisible).Count - 1
    ZoneToFilter.Offset(1, 1).SpecialCells(xlCellTypeVisible).Copy Destination:=Sheets("Journal").Range("B" & FinJ)
    
    
'    Set zone = .Range("A1:A" & FinDup).Find(Pièce)
'        If Not zone Is Nothing Then
'            FirstAd = zone.Address
'            Do
'            Set ZoneToDupliq = zone.Offset(0, 1).Resize(2, 15)
'            ZoneToDupliq.Copy Destination:=Sheets("Journal").Range("B" & finJ)
'            finJ = finJ + 2
'
'            Loop While Not zone Is Nothing And zone.Address <> FirstAd
'        End If
ZoneToFilter.AutoFilter
End With


End Sub

par contre;. il ya quand meme un pb avec ton fichier
parfois il y a des listes de validations, parfois non
dans ton tableau, il y a des formules. ou pas.. et quand il y en a une.. elle n'est pas sur toute la colonne...du coup.. ca fout le boxon..

 

[Yücel]

Bonjour Vgendron,

En récupérant une partie de votre code ci-dessous, c'est exactement ça sauf qu'il ne s'ajoute pas au tableau mais à la feuille en laissant une ligne de vide...

Private Sub Dupliquer_Click()

Dim ZoneToFilter As Range
With ActiveSheet
    Pièce = .Range("C6")
    finJ = .Range("B" & .Rows.Count).End(xlUp).Offset(1).Select
End With

With Sheets("Source")
    FinDup = .Range("A" & .Rows.Count).End(xlUp).Row
    Set zone = .Range("A1:A" & FinDup).Find(Pièce)
        If Not zone Is Nothing Then
            FirstAd = zone.Address
            Do
            Set ZoneToDupliq = zone.Offset(0, 1).Resize(2, 15)
            ZoneToDupliq.Copy Destination:=Sheets("Journal").Range("B" & finJ)
            finJ = finJ + 2

            Loop While Not zone Is Nothing And zone.Address <> FirstAd
        End If

End With

End Sub

Merci pour votre aide.

 

[Dranreb]

Bonjour.
Au plus court :

Private Sub Dupliquer_Click()
   With Me.ListObjects(1)
      .ListRows.Add
      .ListRows.Add.Range.Offset(-1).Resize(2).Value _
         = Feuil6.[B2:P3].Offset(3 * Me.[C6].Value).Value
      End With
   End Sub

Mais attention, les modèles copié ne sont pas cohérents avec les lignes déjà en place, de sortes que les MFC réagissent mal.

 

[Dranreb]

Vous devriez simplifier les formules de vos MFC parce que =SI(Expression;VRAI;FAUX)
revient à tout simplement =Expression

 

[Dranreb]

Vous pouvez ajouter certaines formules :

Private Sub Dupliquer_Click()
   Dim Rng As Range
   With Me.ListObjects(1)
      .ListRows.Add
      Set Rng = .ListRows.Add.Range.Offset(-1).Resize(2)
      End With
   Rng.Value = Feuil6.[B2:P3].Offset(3 * Me.[C6].Value).Value
   Rng(2, 1).FormulaR1C1 = "=R[-1]C"
   Rng(1, 2).FormulaR1C1 = "=R[-1]C+1"
   Rng(2, 2).FormulaR1C1 = "=R[-1]C"
   End Sub

 

[Yücel]

Bonjour Dranreb !

Merci bcp !! on se rapproche bcp sauf quelques petit anomalie. Tu trouveras ci-joint mon fichier avec les annotations.

Très bonne journée à vous.

 

[Dranreb]

Ah oui mais c'est vous qui avez mis des formules depuis, dans vos modèles. Il n'y en avait pas au départ. Alors soit vous essayez avec un pastespecial en formula, soit vous les mettez de toute pièce.
L'important c'est la façon d'ajouter les lignes.

 

[Yücel]

Ah ok je suis vraiment désolé !!

 

[Yücel]

Je peux vous mettre le fichier avec l'ensemble des formules ? svp

 

[Dranreb]

Je ne suis pas sûr que si les formules sont dans les modèles sources elles s'adapteront bien dans les lignes cibles ajoutées. Alors, oui mettez les formules cibles si vous avez des difficultés à les traduire en style de formule R1C1

 

[Yücel]

Je pense pouvoir déchiffrer le code !!! je vais faire des essai avant de vous embêter 😉😀

En tout cas un très grand merci pour votre réactivité !!!!

 

[Yücel]

Finalement dur dur !!! j'ai compris style de formule R1C1 mais les formule à copier sont plus complexe 🙁

N'y a t-il pas un moyen de traduire en macro "récupérer les formules des cellules..." au lieu de les retaper en R1C1 ??

Ci-joint le fichier. merci à vous.