Forum |  HardWare.fr | News | Articles | PC | S'identifier | S'inscrire | Shop Recherche
2794 connectés 

  FORUM HardWare.fr
  Programmation
  VB/VBA/VBS

  recopie automatique

 


 Mot :   Pseudo :  
 
Bas de page
Auteur Sujet :

recopie automatique

n°2306337
toushusss
Posté le 05-10-2017 à 17:07:11  profilanswer
 

Bonjour à tous,  :hello:  
je souhaiterai améliorer ce code vba pour automatiser le processus. Le but de la macro est de copier automatiquement une ligne d'un tableau dans un autre en fonction d'un critère défini. Pour expliquer ce que je souhaite faire j'ai sur une feuille excel  
Feuille 1 : tableau général (A :Nom, B : prénom, C: age et D : n° de groupe)
Feuille 2 : tableau groupe 1 (A :Nom, B : prénom, C: age)
feuille 3 : tableau groupe 2 (A :Nom, B : prénom, C: age)
ETC
Selon le n° de groupe dans la colonne D de la feuille 1 cela recopie automatiquement la ligne correspondante dans un des tableau sur les feuilles suivantes (feuille crée par groupe)
La macro existante fonctionne mais en double cliquant à chaque fois sur les cellules de la colonne D. Je cherche à automatiser cela si possible. Par exemple en attribuant le déroulement de la macro par un clique sur un Useform.
Voilà le code:  
 
Option Explicit
 
Dim f As Worksheet, fd As Worksheet
 
Private Sub Worksheet_Change(ByVal Target As Range)
     
    If Target.Count > 1 Then Exit Sub
    Application.EnableEvents = False
    Set fd = ActiveSheet
    If Not Intersect(Target, Range("D2:D" & Range("A" & Rows.Count).End(xlUp).Row)) Is Nothing Then
        On Error GoTo NlleF
        Set f = Sheets(Target.Value)
        On Error GoTo 0
        fd.Range(fd.Cells(Target.Row, "A" ), fd.Cells(Target.Row, "C" )).Copy f.Range("A" & Rows.Count).End(xlUp)(2)
    End If
fin:
    Application.EnableEvents = True
Exit Sub
 
NlleF:
    If Target.Value = "" Then GoTo fin
    Sheets.Add.Move After:=Sheets(Sheets.Count)
    ActiveSheet.Name = Target.Value
    fd.Range("A1:C1" ).Copy ActiveSheet.Range("A1" )
    Resume
End Sub
 
Merci de votre aide

mood
Publicité
Posté le 05-10-2017 à 17:07:11  profilanswer
 

n°2306360
milfeuille​s
BF1: superbanane
Posté le 06-10-2017 à 09:48:58  profilanswer
 

Salut.
 
Ton code fonctionne à chaque modification de cellule. A chaque fois que tu rentres un nom de groupe dans la cellule D, il copie les valeurs des cellules A, B, C dans l'onglet correspondant au groupe. Bref, ça tu le sais, ça fonctionne bien.
 
Mais du coup, est-ce que ce que tu veux faire, c'est rentrer toutes tes données dans ta feuille générale puis cliquer sur un bouton qui va remplir les feuilles groupes avec toutes les données de la feuille générale ?
En gros, ne plus lancer automatiquement le code à chaque modif de cellule, mais manuellement avec un bouton ?


Message édité par milfeuilles le 06-10-2017 à 09:49:51
n°2306402
toushusss
Posté le 07-10-2017 à 21:10:49  profilanswer
 

Salut Milfeuilles, merci de t'intéresser à mon problème. Oui c'est exactement ce que je cherche. Merci

n°2306454
milfeuille​s
BF1: superbanane
Posté le 09-10-2017 à 09:19:07  profilanswer
 

Pour passer d'une action automatique à une action sur un bouton, il faut virer

Citation :

Private Sub Worksheet_Change(ByVal Target As Range)


et le remplacer par une procédure que tu nommes comme tu veux

Citation :

Sub RecopieAutomatique()


 
Ensuite, la variable "Target" n'est plus utilisable, puisqu'elle était activée par modification de la cellule et n'avait d'effet que sur la ligne en cours. Il faut maintenant boucler sur toutes les lignes, d'où la boucle "for" et l'utilisation de la variable "i" pour passer d'une ligne à l'autre.
Il y a d'autres soucis à régler dans l'exécution du code par la suite, n'hésite pas à demander si y'a un truc que tu ne comprends pas.
 
Ca donne ça:

Citation :


Option Explicit
 
Sub RecopieAutomatique()
 
Dim f As Worksheet, fd As Worksheet
Dim NomFeuille As String
Dim i As Integer
 
For i = 2 To Range("A" & Rows.Count).End(xlUp).Row
 
    Set fd = ActiveSheet
 
    If Not Intersect(Range("D" & i), Range("D2:D" & Range("A" & Rows.Count).End(xlUp).Row)) Is Nothing Then
        On Error GoTo NlleF
        Set f = Sheets(Range("D" & i).Value)
        On Error GoTo 0
        fd.Range(fd.Cells(Range("D" & i).Row, "A" ), fd.Cells(Range("D" & i).Row, "C" )).Copy f.Range("A" & Rows.Count).End(xlUp)(2)
        GoTo fin
    End If
 
NlleF:
    NomFeuille = Range("D" & i)
    If Range("D" & i).Value = "" Then GoTo fin
    Sheets.Add.Move After:=Sheets(Sheets.Count)
    ActiveSheet.Name = NomFeuille
    fd.Range("A1:C1" ).Copy ActiveSheet.Range("A1" )
    fd.Activate
    Resume
     
fin:
Next i
 
End Sub


 
Tu peux soit appeler la macro classiquement avec l'onglet développeur, soit créer un bouton sur ta page (onglet développeur/insérer/bouton) et lui affecter la macro.
 
Bonne journée. :)


Message édité par milfeuilles le 09-10-2017 à 09:26:49
n°2306592
milfeuille​s
BF1: superbanane
Posté le 12-10-2017 à 10:40:15  profilanswer
 

Alors, ça fonctionne pour toi ?

n°2306725
toushusss
Posté le 16-10-2017 à 09:40:55  profilanswer
 

Bonjour à tous
Salut Milfeuilles, j'essai de faire tourner le code avec mon fichier, mais j'ai des bugs que j'essaye de résoudre. Pas évident mais bon j'essaye de bidouiller le code.
Merci
A plus


Aller à :
Ajouter une réponse
  FORUM HardWare.fr
  Programmation
  VB/VBA/VBS

  recopie automatique

 

Sujets relatifs
Impression et mise en page automatique mise en forme automatique des titres d'un fichier word par un macro v
[PHP] Tableau automatique, mais des lignes sautentSélectionner en automatique les lignes d'un résultat d'un filtre
AIDE Structure organisé automatique DEBUTANTplateforme d'envoi de sms automatique
Date et heure automatique // installation silencieuseCréation automatique de dossier
Désactiver saisie semi automatique sur un champs HTML (Chrome)Comment générer des images de 256 px par 240 px de façon automatique
Plus de sujets relatifs à : recopie automatique


Copyright © 1997-2022 Hardware.fr SARL (Signaler un contenu illicite / Données personnelles) / Groupe LDLC / Shop HFR