[VBA [XL 2010] Recupérer dans un onglet les informations d'autres tableau

Version imprimable

1 pièce(s) jointe(s)

Bonsoir,

Je dois faire une petite fichier excel, et destiné à d'autre personne. Je veux que dans la cellule (ici "K2") de l'onglet (ici "Fiche Secteur") lorqu'on rentre le numero de secteur (pour le momment de 1 à 7), cela me ressorte les informations contenu dans les autres tableaux. Comme c'est le cas pour le premier.

J'ai commencé avec le premier onglet, mais je bute sur la manière de faire pour les 3 autres onglets.

J'en appelle à l'aide de ce forum.

Merci et bonne fin de dimanche.

voici le code au cas ou mon fichier exemple pose problème.
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 Private Sub worksheet_Change(ByVal target As Range) 'Déclaration des variables Dim pl As Range, derl&, nl&, dl& If target.Address <> "$K$2" Then Exit Sub Application.ScreenUpdating = False test = True Rows(3).Resize(1000).Clear With Sheets("Bases Communes") dl = .Range("A" & .Rows.Count).End(xlUp).Row Set pl = .Range("A1:H" & dl) .Range("A3").AutoFilter Field:=9, Criteria1:=Sheets("Fiche Secteur").[K2] 'Filtre le tableau par rapport au secteur nl = Range("A3:A" & .Range("A65536").End(xlUp).Row).SpecialCells(12).Count pl.SpecialCells(12).Copy Range("A4") 'Copie le tableau filtré .Range("A3").AutoFilter 'suprime le filtre End With test = fasle Application.ScreenUpdating = True End Sub

Bonjour,

Chez moi, ça à l'air de marcher.
J'ai ajouté "Option explicit et du coup, j'ai eu une erreur de compilation.
Après correction des erreurs et suppression des choses inutiles (variable Test), ça donne ceci :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Option Explicit
Private Sub worksheet_Change(ByVal target As Range)
Dim pl As Range, derl&, nl&, dl&
  If target.Address <> "$K$2" Then Exit Sub
  Application.ScreenUpdating = False
  Rows(3).Resize(1000).Clear
  With Sheets("Bases Communes")
    dl = .Range("A" & .Rows.Count).End(xlUp).Row
    Set pl = .Range("A1:H" & dl)
     .Range("A3").AutoFilter Field:=9, Criteria1:=Sheets("Fiche Secteur").[K2]   'Filtre le tableau par rapport au secteur
     nl = Range("A3:A" & .Range("A65536").End(xlUp).Row).SpecialCells(12).Count
     pl.SpecialCells(12).Copy Range("A4") 'Copie le tableau filtré
     .Range("A3").AutoFilter  'suprime le filtre
  End With
  Application.ScreenUpdating = True
End Sub

[VBA] - Eviter les lignes blanches supplémentaire

Voila l'intégralité du code avec l'ensemble de mes tableaux.

Il me reste la dernière étapes, c'est à dire améliorer le code pour ne pas avoir des lignes vides. Actuellement le code fait copier le tableau a t - elle et t-elle endroit, je cherche juste à ce que chaque tableau vient deux ligne après le dernier.

Merci

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
43
44
45
46
47
48
49
Private Sub worksheet_Change(ByVal target As Range)
 
'Déclaration des variables
 
Dim pl As Range, derl&, nl&, dl&
If target.Address <> "$K$2" Then Exit Sub
Application.ScreenUpdating = False
test = True
Rows(3).Resize(1000).Clear
 
With Sheets("Bases Communes")
dl = .Range("A" & .Rows.Count).End(xlUp).Row
Set pl = .Range("A1:H" & dl)
.Range("A3").AutoFilter field:=10, Criteria1:=Sheets("Fiche Secteur").[K2]   'Filtre le tableau par rapport au secteur
nl = Range("A3:A" & .Range("A65536").End(xlUp).Row).SpecialCells(12).Count
pl.SpecialCells(12).Copy Range("A4") 'Copie le tableau filtré
.Range("A3").AutoFilter  'suprime le filtre
End With
 
 
With Sheets("Bases Donnée Démographique")
dl1 = .Range("A" & .Rows.Count).End(xlUp).Row
Set pl1 = .Range("B1:I" & dl)
.Range("A3").AutoFilter field:=10, Criteria1:=Sheets("Fiche Secteur").[K2]   'Filtre le tableau par rapport au secteur
nl1 = Range("A3:A" & .Range("A65536").End(xlUp).Row).SpecialCells(12).Count
pl1.SpecialCells(12).Copy Range("A40") 'Copie le tableau filtré
End With
 
With Sheets("Bases Résultat 2013")
dl2 = .Range("A" & .Rows.Count).End(xlUp).Row
Set pl2 = .Range("C1:J" & dl)
.Range("A3").AutoFilter field:=1, Criteria1:=Sheets("Fiche Secteur").[K2]   'Filtre le tableau par rapport au secteur
nl2 = Range("A3:A" & .Range("A65536").End(xlUp).Row).SpecialCells(12).Count
pl2.SpecialCells(12).Copy Range("A75") 'Copie le tableau filtré
test = fasle
Application.ScreenUpdating = True
End With
 
 
With Sheets("Bases Résultat 2012")
dl3 = .Range("A" & .Rows.Count).End(xlUp).Row
Set pl3 = .Range("C1:J" & dl)
.Range("A3").AutoFilter field:=1, Criteria1:=Sheets("Fiche Secteur").[K2]   'Filtre le tableau par rapport au secteur
nl3 = Range("A3:A" & .Range("A65536").End(xlUp).Row).SpecialCells(12).Count
pl3.SpecialCells(12).Copy Range("A108") 'Copie le tableau filtré
test = fasle
Application.ScreenUpdating = True
End With
End Sub