Creer un tableau a partir d'autres tableau

Version imprimable

25/11/2009, 18h20
Gorille72

Creer un tableau a partir d'autres tableau

Bonjour,

J'ai une problématique qui me paraissait simple mais il semble que cela soit compliqué (peux être suis-je entouré de personnes aussi neuneux que moi en Excel...). Bref j'aurais bien besoin d'aide.

Voila j'ai une feuille excel avec plusieurs onglets. Dans chaque onglet il y a le même tableau (même structure et champs mais évidement les valeurs sont différentes). Une des colonnes de ces tableaux (appelons la "Résumé") est un simple champs binaire (OUI/NON) qui indique si la ligne doit être prise en compte ou non dans un tableau résumé final (que je cherche à construire justement).

J'ai donc créé un nouvel onglet "Résumé" dans lequel je veux simplement créer automatiquement un tableau constitué de toutes les lignes des mes autres tableaux dont le champ "Résumé" vaut "OUI". A contrario les lignes dont le champs "Résumé" vaut "NON" seront ignorées.

J'espere avoir été assez clair...

Merci beaucoup pour votre aide.

Gorille

Fusion de fichier

Bien sûr que c'est possible; Il n'y a aucune difficulté.

On fait une lecture de chacun des feuillets.
Si ce n'est pas le feuillet fusion , on calcule le nombre de ligne.
On parcourt chaque ligne du fichier pour voir si le flag Résumé est à "OUI".

J'ai fait au plus simple.

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
 
Sub fusion_feuillet()
Const feuille_fusion = "FUSION"
Dim feuille_fusion_existe As Boolean
feuille_fusion_existe = False
 
For Each feuill In ActiveWorkbook.Worksheets
If UCase(feuill.name) = feuille_fusion Then feuille_fusion_existe = True: Exit For
Next
 
If feuille_fusion_existe = True Then
  Worksheets(feuille_fusion).Cells.ClearContents
Else
  ActiveWorkbook.Worksheets.Add
  ActiveWorkbook.ActiveSheet.name = feuille_fusion
End If
 
col_resumé = 5  ' A adapter selon le fichier.
num_ligne_fusion = 2  ' on commence l'écriture à la ligne 2 , on peut mettre les entetes sur la ligne 1
   For Each f1 In ActiveWorkbook.Worksheets
         If UCase(f1.name) <> feuille_fusion Then
            nb_lig_feuill = Worksheets(f1.name).Range("A65536").End(xlUp).Row
 
          For ligne = 1 To nb_lig_feuill
             If Worksheets(f1.name).Cells(ligne, col_resumé).Value = "OUI" Then
                 Worksheets(feuille_fusion).Range("A" & num_ligne_fusion & ":H" & num_ligne_fusion).Value = Worksheets(f1.name).Range("A" & ligne & ":H" & ligne).Value
                 num_ligne_fusion = num_ligne_fusion + 1
             End If
          Next
 
        End If
      Next f1
End Sub

Bonjour

Voici un code qui permet cela. Il faut adapter la plage à copier en fonction de tes besoins.

Note aussi que ce code transfère les données de TOUTES les feuilles, hormis la feuille appelée "Résumé"
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 Sub Transfert() Dim Feuille As Worksheet Dim Cellule As Range For Each Feuille In Worksheets If Feuille.Name <> "Résumé" Then For Each Cellule In Feuille.Range("a2:a" & Feuille.Range("a" & Feuille.Rows.Count).End(xlUp).Row) If Cellule(1, 3) = "Oui" Then _ Range(Cellule, Cellule(1, 3)).Copy Worksheets("Résumé").Range("a" & Feuille.Rows.Count).End(xlUp)(2) Next Cellule End If Next Feuille End Sub
Note la façon d'utiliser l'objet, et la façon générique de trouver la dernière cellule utilisée en A, qui permet l'utilisation du code tant en 2003 que dans les versions suivantes...