Dupliquer certaines données selon un Critère

[tekmars]

Bonjour à tous,
Je souhaite utiliser une macro qui permet de filtrer les données selon un critère (dans mon exemple selon le code 1430 de la colonne C ) , puis copier les lignes correspondantes à ce code puis enlever le filtre et coller la sélection en bas des données (la première ligne vide).
Le but étant de dupliquer certaines lignes (données correspondantes au code 1430).

Merci d’avance pour votre aide.

 

[ledzepfred]

Re : Dupliquer certaines données selon un Critère

Bonjour TEKMARS,

as-tu essayé l'enregistreur de macros : tu déclenches l'enregistreur par Outils / Macros /Nouvelle macro puis tu réalises les étapes que tu souhaites automatiser. Puis tu arrêtes l'enregistreur et tu tapes sur Alt+F11 pour récupérer le code vba, il ne restera qu'à le peaufiner un peu, chose qui peut être faite par un forumeur.

L'enregistreur de macros est le meilleur moyen d'apprendre à coder (en plus de la touche F1 pour l'aide et la recherche sur XLD)

Dans l'attente de te lire

A+

 

[ROGER2327]

Re : Dupliquer certaines données selon un Critère

Bonsoir

Un truc du genre

Sub Toto()
Dim oAdd As String
    oAdd = [A1].Offset(Rows.Count - 1, 0).End(xlUp).Offset(1, 0).Address
    [A1].AutoFilter Field:=3, Criteria1:="1430"
    Intersect([A1].CurrentRegion, Range([A2], [A2].SpecialCells(xlCellTypeLastCell)), Range("A1").SpecialCells(xlCellTypeVisible)).Copy Destination:=Range(oAdd)
    Selection.AutoFilter Field:=3
    Selection.AutoFilter
End Sub

peut faire l'affaire. (Mais on est assez loin de ce que peut donner "l'enregistreur de macros".)​

ROGER2327

 

[tekmars]

Re : Dupliquer certaines données selon un Critère

Un grand merci ROGER2327, c'est exactement ce que je voulais faire.

En effet j'ai essayé de faire cette partie du projet avec l'enregistreur de macro mais ça ne marche que si le nombre de lignes dans le tableau ne varie pas or ce n'est pas le cas !.

Encore merci ROGER2327.

 

[tekmars]

Re : Dupliquer certaines données selon un Critère

Bonjour,

La macro fonctionne très bien si le code 1430 est présent dans une ligne. Par contre j'ai un message d'erreur et blocage de la macro quand le critère n'est pas valable (aucune ligne ne comporte le code 1430).

Comment contourner le problème pour ne pas exécuter cette partie de la macro si le code 1430 est absent.

Merci pour votre aide

 

[ROGER2327]

Re : Dupliquer certaines données selon un Critère

Re...

Essayez ceci :

Sub Toto()
Dim oAdd As String
    If Not Intersect([A1].CurrentRegion, Range([A2], [A2].SpecialCells(xlCellTypeLastCell)), Range("A1").SpecialCells(xlCellTypeVisible)) Is Nothing Then
       oAdd = [A1].Offset(Rows.Count - 1, 0).End(xlUp).Offset(1, 0).Address
       [A1].AutoFilter Field:=3, Criteria1:="1430"
       Intersect([A1].CurrentRegion, Range([A2], [A2].SpecialCells(xlCellTypeLastCell)), Range("A1").SpecialCells(xlCellTypeVisible)).Copy Destination:=Range(oAdd)
       Selection.AutoFilter Field:=3
       Selection.AutoFilter
    End If
End Sub

ROGER2327

 

[tekmars]

Re : Dupliquer certaines données selon un Critère

Bonjour,

Merci pour la tentative mais ça ne marche pas (il ne se passe rien).

j'ai essayé ça :

Dim oAdd As String
       oAdd = [A1].Offset(Rows.Count - 1, 0).End(xlUp).Offset(1, 0).Address
       [A1].AutoFilter Field:=3, Criteria1:="9999"
       [COLOR="Red"]If Not Intersect([A1].CurrentRegion, Range([A2], [A2].SpecialCells(xlCellTypeLastCell)), Range("A1").SpecialCells(xlCellTypeVisible)) Is Nothing Then[/COLOR]
       Intersect([A1].CurrentRegion, Range([A2], [A2].SpecialCells(xlCellTypeLastCell)), Range("A1").SpecialCells(xlCellTypeVisible)).Copy Destination:=Range(oAdd)
       End If
       Selection.AutoFilter Field:=3
       Selection.AutoFilter
   
End Sub

ça l'ai de marcher mais de temps en temps elle me recopie l'entête (la ligne A) et me la place en dernière ligne !

 

[ROGER2327]

Re : Dupliquer certaines données selon un Critère

Re...

C'est évidemment votre syntaxe qui est la bonne. If... Then... doit être après le filtre.
Pour ce qui est de la recopie de la ligne 1, j'observe aussi le phénomène sans pouvoir l'expliquer. Cherchons encore...​

ROGER2327

 

[ROGER2327]

Re : Dupliquer certaines données selon un Critère

Suite...

Changement de méthode... Voyez ceci, qui suppose que la ligne de titres n'est pas vide :

Sub tata()
Dim i As Long, j As Long, l As Long
Dim oDat, oDbl
   oDat = Sheets("A").[C1].CurrentRegion.Value
   l = 1
   ReDim oDbl(1 To UBound(oDat, 2), 1 To l)
   For i = 2 To UBound(oDat, 1)
      If oDat(i, 3) = "1430" Then
         ReDim Preserve oDbl(1 To UBound(oDat, 2), 1 To l)
         For j = 1 To UBound(oDat, 2)
            oDbl(j, l) = oDat(i, j)
         Next j
         l = l + 1
      End If
   Next i
   If Not IsEmpty(oDbl(3, 1)) Then
      Sheets("A").Range(Cells(UBound(oDat, 1) + 1, 1), Cells(UBound(oDat, 1) + UBound(oDbl, 2), UBound(oDat, 2))).Value = Application.Transpose(oDbl)
   End If
End Sub

ROGER2327

 

[tekmars]

Re : Dupliquer certaines données selon un Critère

C'est Nickel, le dernier code marche très bien : je dis chapeau bas 😉

Franchement je vous suis très reconnaissant ROGER2327.

Milles merci pour votre aide.