Discussion :

[waramere]

Bonjour amis développeurs,

C'est avec plaisir que je débute la programmation sur Excel dans le cadre d'un stage dans une entreprise.
Je dois réaliser une macro pour automatiser des données qui seront traités tous les mois.

J'écris sur ce forum, car cela fait bientôt 1 semaine que je suis bloqué. En effet, ma macro a pour but :
- Créer une nouvelle feuille
- Rennomer la feuille
- Chercher dans la premiere feuille (qui est la base de données) les personnes qui travaillent dans le pôle "Recherche et developpement"
- Copier et coller les lignes dans ma nouvelle feuille excel qui correspondent aux personnes qui travaillent dans le pôle recherche et développement

Cependant, ma macro qui devrait automatiser cette manoeuvre nécessite un travail manuelle (changement de ligne a copier si j'ajoute ou supprime un membre).

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
 Sub Addsheets()
    Sheets.Add(After:=Sheets("Feuil1")).Name = "Agent en recherche et développement"
    Sheets("Feuil1").Select
    Rows("2:23").Select
    Selection.Copy
    Sheets("Agent en recherche et developpement").Select
    Range("A2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

Je cherche donc la solution qui dit : "Si il y a "Recherche et developpement" dans les lignes X alors, copier et coller ces lignes dans la feuille "Agent en recherche et developpement"

Merci pour votre aide,

Cordialement,

Le stagiaire

[Invité]

Bonsoir,

Regardes du coté des filtres actif ou filtres élaborés.

[Menhir]

J'écris sur ce forum, car cela fait bientôt 1 semaine que je suis bloqué.

Excuse-moi mais ta "macro" est composé de code brut issu de l'enregistreur de macro (avec ses ribambelles de Select et de paramètres inutiles).
Il est donc tout à fait improbable que ça t'ait pris une semaine pour obtenir ceci.
Je crois que tu te moque de nous.

[waramere]

Merci pour vos réponses, je vais utiliser les filtres car l'autre méthode est beaucoup plus complexe

[waramere]

Merci pour votre réponse rapide,

Mais je ne vois aucune aide dans les liens que vous m'avez envoyer qui me permettrait d'intégrer une condition...

[Thautheme]

Bonjour Waramere, Kiki, bonjour le forum,

Une proposition fonctionnelle mais pas très rapide... Il faudrait plus de détails pour l'améliorer...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
Sub Macro1()
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim OD As Worksheets 'déclare la variable OD (Onglet Destination)
Dim DL As Integer 'déclare la variable DL (Dernière Ligne)
Dim I As Integer 'déclare la variable I (Incrément)
Dim COL As Byte 'déclare la variable COL (COLonne)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)
 
Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
Set OS = Worksheets("Feuil1") 'définit l'onglet source OS
DL = OS.Cells(Application.Rows.Count, "A").End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne A de l'onglet OS
COL = 2 'définit la colonne ou se trouve "Recherche et developpement" (ici 2 : à adapter à ton cas)
Sheets.Add After:=Sheets("Feuil1") 'ajoute un onglet vierge après l'onglet "Feuil1")
Set OD = ActiveSheet 'définit l'onglet destination OD
OD.Name = "Agent en recherche et développement" 'renomme l'onglet destination
For I = 2 To DL 'boucle sur toutes les lignes I de 2 à DL
    If OS.Cells(I, COL).Value = "Recherche et developpement" Then 'condition 1 : si la cellule ligne I colonne COL est égale à "Recherche et developpement"
        If OD.Range("A1") = "" Then 'condition 2 : si A1 de l'onglet destination OD est vide
            Set DEST = OD.Range("A1") 'définit la cellule de destination DEST (=A1)
        Else 'sinon (condition 2)
            Set DEST = OD.Cells(Application.Rows.Count, "A").End(xlUp).Offset(1, 0) 'définit la cellule de destination DEST (la première cellule vide de la colonne A de l'onglet OD)
        End If 'fin de la condition 2
        OS.Rows(I).Copy 'copye la ligne I
        DEST.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 'colle les valeurs dans DEST
    End If 'fin de la condition 1
Next I 'prochaine ligne de la boucle
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
End Sub