Bonjour le forum
Je travaille actuellement sur la réalisation d'une fiche de données.
Dans cette fiche à la saisie du numéro dans la cellule,(K2) mon code VBA doit aller chercher les différents éléments dans les autres onglets (4 onglets différents)
J'ai commencé avec le premier tableau "Bases Communes", le problème que j'ai si je remet à vide ma cellule K2 les cellules du tableau se colorie de la même couleur que A3. Même principe de A3 à A5 les cellules se colorie en violet, or je ne veux pas.
Je galére également pour le reste du code, je suis parti du l'exemple du premier tableau mais je trouve çà lourd et le code devient vite illisible.
Je joint le fichier
Vous avez la maquette c'est à dire à quoi ressemble mon tableau vide (sans avoir rentrer quoi que ce soit)
Secteur automatisé, là ou ca beug
et une cope de secteur automatisé pour que vous testiez
Ou cas ou le code
Merci
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 Private Sub Worksheet_Change(ByVal Target As Range) Dim o As Object 'déclare la variable o (Onglet) Dim dl As Long 'déclare la variable dl (Dernière Ligne) Dim pl As Range 'déclare la variable pl (PLage) Dim nl As Integer 'décalre la variable nl If test = True Then Exit Sub 'si test est "vrai", sort de la procédure If Target.Address <> "$K$2" Then Exit Sub 'si le chamgement a lieu ailleurs qu'en K2, sort de la procédure Application.ScreenUpdating = False 'masque les raffraîchissements d'écran test = True 'définit la variable test 'efface les éventuelles anciennes données If Range("A7") <> "DEMOGRAPHIES" Then Range("A7").CurrentRegion.Resize(Range("A7").CurrentRegion.Rows.Count + 1).EntireRow.Delete Set o = Sheets("Bases Communes") 'définit l'onglet o dl = o.Range("A" & Rows.Count).End(xlUp).Row Set pl = o.Range("A2:H" & dl) 'définit la plage pl o.Range("A2").AutoFilter Field:=10, Criteria1:=Target.Value 'filte le tableau par rapport au secteur nl = o.Range("A1:A" & o.Range("A65536").End(xlUp).Row).SpecialCells(xlVisible).Count Rows(4).Resize(nl).Insert pl.SpecialCells(xlCellTypeVisible).Copy Range("A7") 'copie le tableau filtrée o.Range("A2").AutoFilter 'supprime le filtre test = False 'redéfinit la variable test Application.ScreenUpdating = True 'affiche les raffraîchissements d'écran End Sub
Partager