1 pièce(s) jointe(s)
[VBA] - Ramener des valeur d'autres onglet
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.:mouarf::mouarf::mouarf:
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
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
| 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 |
Merci
