Aide pour un débutant en VBA

Version imprimable

22/12/2022, 11h10
ISAACSLADE

Aide pour un débutant en VBA

Bonjour à tous,

J'ai besoin de vos connaissances s'il vous plaît pour :

Dans un fichier à plusieurs onglets : "OngletA", "OngletB", "OngletC", "OngletD" + un onglet "Liste" + un onglet "STUDG + un onglet "STUDR" + un onglet "SDSR".

Dans les 4 premiers onglets (A,B,C et D), j'ai une même entête de tableau avec des colonnes qui partent de A à N avec une première ligne entête qui démarre en ligne 12 pour tous. Seules les données renseignées après l'entête dans les 4 tableaux divergent. La colonne E "Structure" propose cependant un même choix : "STUDG", "STUDR" et "SDSR". En gros, les informations renseignées dans ces 4 premiers onglets concernent soit "STUDG", soit "STUDR" ou soit "SDSR". Pour le moment, les onglets "STUDG", "STUDR" et "SDSR" sont vides avec simplement l'entête commune des 4 premiers onglets (A,B,C et D) que j'ai collées sans aucune formule.

Ce que j'aimerais : Que pour les 4 premiers onglets (A,B,C et D), en se basant sur la colonne E "Structure", que lorsque il apparait soit le mot "STUDG", soit "STUDR" ou soit "SDSR", toutes les lignes correspondantes (de la colonne A à N) soient copiées et collées les unes après les autres (de manière infinie tant que les 4 premiers onglets sont alimentés) dans son onglet correspondant (EX: Onglet "STUDG" pour toutes les lignes avec en colonne E "Structure" "STUDG") pour les 4 premiers onglets.

Comment y arriver ?

Merci à vous pour l'aide.
22/12/2022, 12h00
Valtrase
Salut,
Deux solutions s'offrent à toi
- A la saisie des informations dans un des onglet (A, B, C, D)
  - On vérifie si l'on trouve "STUDG", "STUDR", "SDSR"
  - Si oui on copie
- Avec un bouton qui va lancer une procédure, celle-ci va vérifier l'existence des chaines "STUDG", "STUDR", "SDSR" dans les 4 onglets et copier les lignes dans le tableau adapté si trouvées.
Quelle méthode tu envisages ?
22/12/2022, 12h34
ISAACSLADE

Merci pour ce retour.

J'imagine la chose à l'ouverture du fichier, lorsque l'on vient alimenter les 4 premiers onglets. Que ça se fasse automatiquement (sans bouton) si possible. Lorsqu'une nouvelle ligne est ajoutée, l'onglet correspondant est alimenté automatiquement.
Si pas possible, un bouton peut faire l'affaire.

Merci encore !!
22/12/2022, 12h54
Philippe Tulliez
Bonjour,

Citation:

Que ça se fasse automatiquement (sans bouton) si possible. Lorsqu'une nouvelle ligne est ajoutée, l'onglet correspondant est alimenté automatiquement

Vous devez donc appeler votre procédure de copie depuis la procédure événementielle Worksheet_Change ou Workbook_SheetChange

Pour en savoir plus sur le sujet, voici le lien de deux tutoriels
- Les évènements dans la feuille de calcul Excel
- Les évènements du module objet ThisWorkbook, dans Excel
22/12/2022, 15h01
deedolith

Salut,

A mon avis, il y a plus simple à faire que recourir à VBA.
1) Des règles de validation pour la colonne E.
2) Power Query.

Certes, on perd la gestion évènementielle, mais par rapport à l'appuis sur 1 bouton (déja existant), se casser la tête à coder est-il rentable ?
22/12/2022, 15h01
ISAACSLADE

Merci pour ces informations mais étant débutant dans le domaine, je ne sais pas quoi faire.

Merci quand même.

Bonne journée.
22/12/2022, 17h43
deedolith

Renseignes-toi sur les technologies,
pèse le pour et le contre,
fait on choix.
22/12/2022, 21h37
ISAACSLADE

Merci encore à vous. Malheureusement, je n’arrive pas à développer quelque chose de viable. Quelqu’un aurait-il l’amabilité de m’indiquer le codage VBA pour arriver à ce que j’aimerais ?

Merci à vous !

1 pièce(s) jointe(s)

Bonjour et bonne fête à ceux qui feront la fête, bonne année 2023
certainement il y a mieux que ce code bricloé
tester ce bricolage en espérant que ça t'aide à avancer

Code:

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
Dim sh As Worksheet
Dim filtre
Dim lig As Long
Dim ligA As Long
Dim ligB As Long
Dim ligC As Long
Dim ligD As Long
ligA = Sheets("A").Range("A" & Rows.Count).End(xlUp).Row
ligB = Sheets("B").Range("A" & Rows.Count).End(xlUp).Row
ligC = Sheets("C").Range("A" & Rows.Count).End(xlUp).Row
ligD = Sheets("D").Range("A" & Rows.Count).End(xlUp).Row
For Each sh In Sheets
If sh.Name <> "A" And sh.Name <> "B" And sh.Name <> "C" And sh.Name <> "D" And sh.Name <> "Liste" Then
filtre = sh.Name
lig = 12
sh.Cells.ClearContents
If Sheets("A").FilterMode Then Sheets("A").ShowAllData
Sheets("A").Range("A12:N" & ligA).AutoFilter Field:=5, Criteria1:=filtre
Sheets("A").Range("A12:N" & ligA).SpecialCells(xlCellTypeVisible).Copy Destination:=sh.Range("A" & lig)
If Sheets("A").FilterMode Then Sheets("A").ShowAllData
lig = sh.Range("A" & Rows.Count).End(xlUp).Row + 1
If Sheets("B").FilterMode Then Sheets("B").ShowAllData
Sheets("B").Range("A12:N" & ligB).AutoFilter Field:=5, Criteria1:=filtre
Sheets("B").Range("A13:N" & ligB).SpecialCells(xlCellTypeVisible).Copy Destination:=sh.Range("A" & lig)
If Sheets("B").FilterMode Then Sheets("B").ShowAllData
lig = sh.Range("A" & Rows.Count).End(xlUp).Row + 1
If Sheets("C").FilterMode Then Sheets("C").ShowAllData
Sheets("C").Range("A12:N" & ligC).AutoFilter Field:=5, Criteria1:=filtre
Sheets("C").Range("A13:N" & ligC).SpecialCells(xlCellTypeVisible).Copy Destination:=sh.Range("A" & lig)
If Sheets("C").FilterMode Then Sheets("C").ShowAllData
lig = sh.Range("A" & Rows.Count).End(xlUp).Row + 1
If Sheets("D").FilterMode Then Sheets("D").ShowAllData
Sheets("D").Range("A12:N" & ligD).AutoFilter Field:=5, Criteria1:=filtre
Sheets("D").Range("A13:N" & ligD).SpecialCells(xlCellTypeVisible).Copy Destination:=sh.Range("A" & lig)
If Sheets("D").FilterMode Then Sheets("D").ShowAllData
End If
Next sh
Application.ScreenUpdating = True
End Sub

23/12/2022, 14h07
ISAACSLADE

1 pièce(s) jointe(s)

Bonjour, merci pour ce retour qui aide beaucoup. J'ai retouché mon fichier d'origine et j'ai essayé d'adapter votre codage. Sans succès...

tester ça :

Code:

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
Sub test()
Application.ScreenUpdating = False
Dim sh As Worksheet
Dim filtre
Dim lig As Long
Dim ligA As Long
Dim ligB As Long
Dim ligC As Long
Dim ligD As Long
ligA = Sheets("ISO9001").Range("E" & Rows.Count).End(xlUp).Row
ligB = Sheets("QUALIPSAD").Range("E" & Rows.Count).End(xlUp).Row
ligC = Sheets("QUALIOPI").Range("E" & Rows.Count).End(xlUp).Row
ligD = Sheets("AMELIORATIONS").Range("E" & Rows.Count).End(xlUp).Row
For Each sh In Sheets
On Error Resume Next
If sh.Name <> "ISO9001" And sh.Name <> "QUALIPSAD" And sh.Name <> "QUALIOPI" And sh.Name <> "AMELIORATIONS" And sh.Name <> "Liste" Then
filtre = sh.Name
lig = 12
sh.Cells.ClearContents
If Sheets("ISO9001").FilterMode Then Sheets("ISO9001").ShowAllData
Sheets("ISO9001").Range("A12:N" & ligA).AutoFilter Field:=5, Criteria1:=filtre
Sheets("ISO9001").Range("A12:N" & ligA).SpecialCells(xlCellTypeVisible).Copy Destination:=sh.Range("A" & lig)
If Sheets("ISO9001").FilterMode Then Sheets("ISO9001").ShowAllData
lig = sh.Cells.Find("*", [A1], , , 1, 2).Row + 1
If Sheets("QUALIPSAD").FilterMode Then Sheets("QUALIPSAD").ShowAllData
Sheets("QUALIPSAD").Range("A12:N" & ligB).AutoFilter Field:=5, Criteria1:=filtre
Sheets("QUALIPSAD").Range("A13:N" & ligB).SpecialCells(xlCellTypeVisible).Copy Destination:=sh.Range("A" & lig)
If Sheets("QUALIPSAD").FilterMode Then Sheets("QUALIPSAD").ShowAllData
lig = sh.Cells.Find("*", [A1], , , 1, 2).Row + 1
If Sheets("QUALIOPI").FilterMode Then Sheets("QUALIOPI").ShowAllData
Sheets("QUALIOPI").Range("A12:N" & ligC).AutoFilter Field:=5, Criteria1:=filtre
Sheets("QUALIOPI").Range("A13:N" & ligC).SpecialCells(xlCellTypeVisible).Copy Destination:=sh.Range("A" & lig)
If Sheets("QUALIOPI").FilterMode Then Sheets("QUALIOPI").ShowAllData
lig = sh.Cells.Find("*", [A1], , , 1, 2).Row + 1
If Sheets("AMELIORATIONS").FilterMode Then Sheets("AMELIORATIONS").ShowAllData
Sheets("AMELIORATIONS").Range("A12:N" & ligD).AutoFilter Field:=5, Criteria1:=filtre
Sheets("AMELIORATIONS").Range("A13:N" & ligD).SpecialCells(xlCellTypeVisible).Copy Destination:=sh.Range("A" & lig)
If Sheets("AMELIORATIONS").FilterMode Then Sheets("AMELIORATIONS").ShowAllData
End If
Next sh
Application.ScreenUpdating = True
End Sub