comment modifier cette macro pour avoir ça(voir fichier)

[falconoz]

Bonjour à tous
je voulais savoir comment on peut modifier cette macro pour avoir cette legère modification si importante pour moi.(voir fichier ci-joint)

D'avance merci

 

[falconoz]

Re : comment modifier cette macro pour avoir ça(voir fichier)

Pardon voila la macro initiale

Sub Transfert()
Dim cel As Range, ref As Range
Application.ScreenUpdating = False
ActiveSheet.AutoFilterMode = False
Sheets("efg").Range("6:65536").Clear
On Error Resume Next
For Each cel In Range("A5:A" & Range("A65536").End(xlUp).Row)
If Application.CountIf(Range("A5:A" & cel.Row), cel) = 1 Then
Set ref = Sheets("efg").Range("B65536").End(xlUp)(2)
cel.Copy ref.Offset(0, -1)
Range("A4:C65536").AutoFilter Field:=1, Criteria1:=cel
Range("C5:C" & Range("C65536").End(xlUp).Row).SpecialCells(xlVisible).Copy ref
Range("A4:C65536").AutoFilter
End If
Next
Application.ScreenUpdating = True
End Sub

 

[job75]

Re : comment modifier cette macro pour avoir ça(voir fichier)

Bonjour falconoz,

Ce n'était pas la peine d'ouvrir un nouveau fil.

Voici le fichier modifié et la nouvelle macro :

Sub Transfert()
Dim cel As Range, ref As Range
Application.ScreenUpdating = False 'l'écran est figé
ActiveSheet.AutoFilterMode = False ' retire le filtre automatique au cas où il serait en place
Sheets("efg").Range("6:65536").Clear ' efface tout à partir de la ligne 6 feuille efg
For Each cel In Range("A5:A" & Range("A65536").End(xlUp).Row) ' feuille active : étudie les cellules de la colonne A
  If Application.CountIf(Sheets("efg").Range("A5:A65536"), cel) = 0 Then 's'il s'agit d'une nouvelle valeur (CountIf est l'équivalent de NB.SI)
    Set ref = Sheets("efg").Range("A65536").End(xlUp)(2) ' ref = cellule sous la dernière cellule colonne A feuille efg
    Range("A4:C65536").AutoFilter Field:=1, Criteria1:=cel ' feuille active : mise en place du filtre et filtrage suivant valeur colonne A
    Range("A5:A" & Range("A65536").End(xlUp).Row).SpecialCells(xlVisible).Copy ref 'copie de la zone filtrée colonne A vers ref
    Range("C5:C" & Range("A65536").End(xlUp).Row).SpecialCells(xlVisible).Copy ref.Offset(0, 1) 'copie de la zone filtrée colonne C
    Range("A4:C65536").AutoFilter ' le filtre est retiré
  End If
Next
Application.ScreenUpdating = True
End Sub

A+

 

[job75]

Re : comment modifier cette macro pour avoir ça(voir fichier)

Re,

Définir la variable plage, c'est quand même mieux :

Sub Transfert()
[COLOR="Red"]Dim plage[/COLOR] As Range, cel As Range, ref As Range
Application.ScreenUpdating = False 'l'écran est figé
ActiveSheet.AutoFilterMode = False ' retire le filtre automatique au cas où il serait en place
Sheets("efg").Range("6:65536").Clear ' efface tout à partir de la ligne 6 feuille efg
[COLOR="Red"]Set plage[/COLOR] = Range("A5:A" & Range("A65536").End(xlUp).Row) ' feuille active : plage étudiée
For Each cel In [COLOR="Red"]plage[/COLOR]
  If Application.CountIf(Sheets("efg").Range("A5:A65536"), cel) = 0 Then 's'il s'agit d'une nouvelle valeur en feuille efg (CountIf est l'équivalent de NB.SI)
    Set ref = Sheets("efg").Range("A65536").End(xlUp)(2) ' ref = cellule sous la dernière cellule colonne A feuille efg
    Range("A4:C65536").AutoFilter Field:=1, Criteria1:=cel ' feuille active : mise en place du filtre et filtrage suivant valeur colonne A
    [COLOR="Red"]plage[/COLOR].SpecialCells(xlVisible).Copy ref 'copie de la zone filtrée colonne A vers ref
    [COLOR="Red"]plage.Offset(0, 2).[/COLOR]SpecialCells(xlVisible).Copy ref.Offset(0, 1) 'copie de la zone filtrée colonne C
    Range("A4:C65536").AutoFilter ' le filtre est retiré
  End If
Next
Application.ScreenUpdating = True
End Sub

A+

 

[falconoz]

Re : comment modifier cette macro pour avoir ça(voir fichier)

ah ok je vois.
merci encore une fois