macro d'une boucle copier coller d'un tableau après un filtre.

[mimi270188]

Bonjour,

Je souhaite créer une macro qui aurait pour but de sélectionner un tableau obtenus après un filtre.

puis de le copier/coller en dessous de lui même un nombre de fois que je lui aurai demandé.


Si sa peu vous aider à comprendre:

je doit filtrer des produits dans un tableau(plusieurs dizaines) auxquels mes clients ont le droit.
mais plusieurs client on le droit à cette même liste obtenus et je doit mettre leurs numéros client à gauche de cette liste et en face de chaque produits.
donc je doit copier/coller ce tableau en dessous de lui-même autant de fois que j'ai de client qui on le droit à cette liste.

Donc la macro devra être capable de s'adapter a la taille du tableau et de copier un nombre de fois choisit par l'utilisateur (moi) .

Merci à ceux qui prendrons le temps de me répondre 😱

 

[Staple1600]

Re : macro d'une boucle copier coller d'un tableau après un filtre.

Bonsoir et bienvenue

Un fichier exemple illustrant ta problématique nous aiderait à t'aider

Il te suffit de :
Modifier le message/Options supplémentaires/Pièces jointes/Gérer les pièces jointes

(fichier <48ko ou zippé (*.xls de préférence car tout le monde sur le forum n'a pas Excel 2010 ou 2007)

 

[flyonets44]

Re : macro d'une boucle copier coller d'un tableau après un filtre.

Bonjour
Voici un code que j'ai créé qui pourrait t'aider, après adaptation à ton cas bien sur
Sub FiltreAutoperso()
'1-FILTRER SUR LE CONTENU D UNE CELLULE DANS UNE COLONE
'2-OPTION 1:COLORIER LES LIGNES VISIBLES
'3-option 2:COPIER LES LIGNES VISIBLES VERS UNE AUTRE FEUILLE
'4-option 2:COPIER LES LIGNES VISIBLES VERS UNE AUTRE FEUILLE
'SUPPRIMER LES LIGNES FILTREES DE LA FEUILLE SOURCE
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim K&, Nbcol&, Vcol&, Choix&, Nomf As String
Dim Actuel As String, Rgf As Range, Rgt As Range, Plage As Range
Actuel = ActiveCell.Value: Nomf = ActiveSheet.Name
Vcol = ActiveCell.Column
K = Cells(65536, Vcol).End(xlUp).Row
Set Plage = Sheets(Nomf).Range("A1").Offset(1).Resize(K, Columns.Count)
Choix = 3 ' OPTION DU FILTRE
Set Rgt = Worksheets("Feuil2").Cells(Rows.Count, 1).End(xlUp) _
.Offset(1, 0)
Cells(1, Vcol).Select
Selection.AutoFilter
With Sheets(Nomf).Cells(1, Vcol)
.AutoFilter field:=Vcol, Criteria1:=Actuel
Set Rgf = Range("_FilterDataBase").Offset(1, 0).Resize(Range("_FilterDataBase"). _
Rows.Count - 1).SpecialCells(xlCellTypeVisible)
Select Case Choix
Case Is = 1 'marquage le résultat du filtre dans la feuille source
Rgf.Interior.ColorIndex = 36
Case Is = 2 'copie le résultat du filtre vers autre feuille
Rgf.Copy Destination:=Rgt
Case Is = 3 'garde uniquementle résultat du filtre dans la feuille destination
'et Purge le résultat du filtre dans la feuille source
Rgf.Copy Destination:=Rgt
Rgf.ClearContents
End Select
End With
' Suppression du filtre automatique
Selection.AutoFilter
If Choix = 3 Then
Set Plage = Sheets(Nomf).Range("A1").Offset(1).Resize(K, Columns.Count)
Plage.Sort [a1]
End If
Set Rgf = Nothing: Set Rgt = Nothing: Set Plage = Nothing
Application.Calculation = xlCalculationAutomatic
End Sub

 

[Staple1600]

Re : macro d'une boucle copier coller d'un tableau après un filtre.

Bonjour le fil

flyonets44
En utilsant cette balise BBCODE :

[NOPARSE]

[/NOPARSE] [FONT=Verdana][SIZE=2][COLOR=darkred][B]ton code VBA[/B][/COLOR][/SIZE][/FONT] [NOPARSE]

[/NOPARSE]

Tu rends ton message plus agréable à lire 😉

Résultat obtenu

Sub FiltreAutoperso()
'1-FILTRER SUR LE CONTENU D UNE CELLULE DANS UNE COLONE
'2-OPTION 1:COLORIER LES LIGNES VISIBLES
'3-option 2:COPIER LES LIGNES VISIBLES VERS UNE AUTRE FEUILLE
'4-option 2:COPIER LES LIGNES VISIBLES VERS UNE AUTRE FEUILLE
            'SUPPRIMER LES LIGNES FILTREES DE LA FEUILLE SOURCE
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim K&, Nbcol&, Vcol&, Choix&, Nomf As String
Dim Actuel As String, Rgf As Range, Rgt As Range, Plage As Range
Actuel = ActiveCell.Value: Nomf = ActiveSheet.Name
Vcol = ActiveCell.Column
K = Cells(65536, Vcol).End(xlUp).Row
Set Plage = Sheets(Nomf).Range("A1").Offset(1).Resize(K, Columns.Count)
Choix = 3 ' OPTION DU FILTRE
Set Rgt = Worksheets("Feuil2").Cells(Rows.Count, 1).End(xlUp) _
.Offset(1, 0)
Cells(1, Vcol).Select
Selection.AutoFilter
  With Sheets(Nomf).Cells(1, Vcol)
    .AutoFilter field:=Vcol, Criteria1:=Actuel
    Set Rgf = Range("_FilterDataBase").Offset(1, 0).Resize(Range("_FilterDataBase"). _
    Rows.Count - 1).SpecialCells(xlCellTypeVisible)
    Select Case Choix
    Case Is = 1 'marquage le résultat du filtre dans la feuille source
    Rgf.Interior.ColorIndex = 36
    Case Is = 2 'copie le résultat du filtre vers autre feuille
    Rgf.Copy Destination:=Rgt
    Case Is = 3 'garde uniquementle résultat du filtre dans la feuille destination
                'et Purge le résultat du filtre dans la feuille source
    Rgf.Copy Destination:=Rgt
    Rgf.ClearContents
    End Select
  End With
  ' Suppression du filtre automatique
  Selection.AutoFilter
  If Choix = 3 Then
    Set Plage = Sheets(Nomf).Range("A1").Offset(1).Resize(K, Columns.Count)
    Plage.Sort [a1]
  End If
Set Rgf = Nothing: Set Rgt = Nothing: Set Plage = Nothing
Application.Calculation = xlCalculationAutomatic
End Sub