Bonjour à tous,
J'essaie de faire une macro qui permettent d'alimenter 2 onglets, par rapport à un autre onglet par rapport à un filtre.
Cependant, j'ai une erreur 1004 : "vous ne pouvez pas coller cet élément ici, car les zones de copier et de collage sont différentes"
Pouvez-vous m'aider svp ?
La macro ci-dessous :
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
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78 Sub Extraction() ' D?claration des variables c'est ? dire des noms des collaborateurs Dim Collaborateur1 Collaborateur1 = Sheets("1. Mode op?ratoire").Range("L56").Value Dim Collaborateur2 Collaborateur2 = Sheets("1. Mode op?ratoire").Range("L57").Value ' Affiche toutes les colonnes de l'onglet extraction ' N?cessaire pour faire le copier / coller Sheets("3. Extraction").Select Columns("A:M").Select Selection.EntireColumn.Hidden = False ' Effectue un filtre dans l'onglet extraction en A6 sur le Collaborateur 1 Range("A6").Select With Selection .AutoFilter .AutoFilter Field:=1, Criteria1:=Collaborateur1 End With ' Copier les donn?es du collaborateur 1 Range("A7:M7").Select Range(Selection, Selection.End(xlDown)).Select Selection.Copy ' Coller les donn?es du collaborateur 1 dans son onglet Sheets(Collaborateur1).Select Range("A65536").End(xlUp).Offset(1, 0).Select ActiveSheet.Paste ' D?sactive le filtre de l'onglet Extraction Sheets("3. Extraction").Select With Sheets("3. Extraction") If .AutoFilterMode Then .Cells.AutoFilter End If End With ' Effectue un filtre dans l'onglet extraction en A6 sur le Collaborateur 2 Range("A6").Select With Selection .AutoFilter .AutoFilter Field:=1, Criteria1:=Collaborateur2 End With ' Copier les donn?es du collaborateur 2 Range("A7:M7").Select Range(Selection, Selection.End(xlDown)).Select Selection.Copy ' Coller les donn?es du collaborateur 2 dans son onglet Sheets(Collaborateur2).Select Range("A65536").End(xlUp).Offset(1, 0).Select ActiveSheet.Paste ' Masquer les colonnes inutiles de l'onglet extraction ' Les colonnes sont n?cessaires pour le copier / coller Sheets("3. Extraction").Select Columns("B:E").Hidden = True ' Supprimer les filtres de la base de l'onglet extraction With Sheets("3. Extraction") If .AutoFilterMode Then .Cells.AutoFilter End If End With 'Supprimer l'extraction ActiveSheet.Range("A7:M3000").ClearContents Range("A1").Select MsgBox "Les feuilles de travail ont ?t? mises ? jour :)" End Sub
Partager