Répétition de formule copier - coller avec VBA

[877176]

Bonjour à tous,

Je cherche à faire une macro associée à un bouton, qui me permet de copier une référence sur une autre feuille si la valeur qui lui est associée dépasse un certain seuil.
[voir fichier joint]
Par exemple, toute les ref qui ont une valeur qui dépasse 3 doivent être copiées dans la colonne A de la feuille "pose"...

Merci par avance pour votre aide !

 

[Efgé]

Re : Répétition de formule copier - coller avec VBA

Bonjour 877176 et bienvenu sur le forum

Au plus simple:

Private Sub CommandButton1_Click()
Dim i&
For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
    If Range("B" & i) > 3 Then
        Range("A" & i).Copy Sheets("pose").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
    End If
Next i
End Sub

Cordialement

 

[Robert]

Re : Répétition de formule copier - coller avec VBA

Bonjour numéros et bienvenu, bonjour le forum,

En pièce jointe ton fichier modifié avec la macro événementielle Change ci-dessous. Entre une valeur dans le seuil (en F1) et tout les références dont la valeur est supérieure au seuil renseigné seront copiées dans l'onglet pose.
le code :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim dl As Integer 'déclare la variable dl (Dernière Ligne)
Dim pl As Range 'déclare la variable pl (PLage)

If Target.Address <> "$F$1" Then Exit Sub 'si le changement a lieu ailleurs qu'en F1, sort de la procédure
If Target.Value = "" Then 'condition : si F1 est effacée
    With Sheets("pose") 'prend en compte l'onglet "pose"
        'si A2 n'est pas vide, efface les anciennes données
        If .Range("A2") <> "" Then .Range("A2:A" & .Cells(Application.Rows.Count, 1).End(xlUp).Row).Clear
    End With 'fin de la prise en compte de l'onglet "pose"
    Exit Sub 'sort de la procédure
End If 'fin de la condition
If Selection.Cells.Count > 1 Then Exit Sub 'si plusieurs cellules sélectionnées, sort de la procédure
Application.ScreenUpdating = False 'masque les changements à l'écran
With Sheets("pose") 'prend en compte l'onglet "pose"
    'si A2 n'est pas vide, efface les anciennes données
    If .Range("A2") <> "" Then .Range("A2:A" & .Cells(Application.Rows.Count, 1).End(xlUp).Row).Clear
End With 'fin de la prise en compte de l'onglet "pose"
dl = Cells(Application.Rows.Count, 1).End(xlUp).Row 'définit la dernière ligne éditée dl de la colonne 1 (=A)
Set pl = Range("A2:A" & dl) 'définit la palge pl
Range("A1").AutoFilter 'active le filtre automatique
Range("A1").AutoFilter field:=2, Criteria1:=">" & Range("F1").Value 'filtre automatique de la colonne 2 en fonction du ctritère : > à F1
On Error Resume Next 'gestion des erreurs (passe à la ligne suivante si une erreur a été générée, si la palge des cellules visibles de pl est vide, cela génère une erreur)
pl.SpecialCells(xlCellTypeVisible).Copy Sheets("pose").Range("A2") 'copy les cellules visibles de la plage pl et les colle en A2
Range("A1").AutoFilter 'désactive le filtre automatique
Application.ScreenUpdating = True 'afficheles changements à l'écran
End Sub

Le fichier :

 

[Efgé]

Re : Répétition de formule copier - coller avec VBA

Re, Bonjour Robert
J'ajoute à mon court code précédent, une version formule.
Cordialement

 

[877176]

Re : Répétition de formule copier - coller avec VBA

Merci pour vos retours !
Cette aide me sera très précieuse 🙂
PS : Robert >> Ta macro guidée = un bonheur !

 

[877176]

Re : Répétition de formule copier - coller avec VBA

Robert & Efgé,
Je viens de rencontrer un nouveau problème... Dans la feuille 'BLOOM DATA' je souhaite créer une macro liée à un bouton qui copie et décale les colonnes A,B et C de 5 colonnes sur la droite afin de pouvoir accumuler mes données, à droite, une fois que je les ai télécharger de ma base de donnée... En gros c'est comme si j'insérai 5 colonnes à gauche de A:A, c'est à dire que tout ce qui est à droite de A se décale ensemble. J'ai essayer avec Offset(0,5) mais je pense que je ne code pas de la bonne manière... Je suis encore trop débutant 🙂
Merci pour votre aide ! [ fichier joint ]
Guillaume