Discussion :

[zzman]

Bonjour,
Je cherche à générer de façon automatique un tableau, en récupérant les données provenant d'un autre classeur où les lignes correspondent à un certain type.

J'ai mis 2 fichiers de ce que j'aimerais avoir. Le tableau avec les produits ListeGénérale.A partir de ce tableau un tableau est généré automatiquement dans le fichier ListeInformatique. Le tableau doit s'ajuster aux nombres de références suivant qu'on en ajoute ou retire dans le fichier de le liste principale des références.

voila merci.

[ouskel'n'or]

Juste pour le principe : Pour que ça fonctionne, tu dois créer une feuille "Fournitures" dans le fichier "ListeInformatique.xls"

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
Sub CopierCollerListeInfo()
    'Copie de la ligne de titre
    Workbooks("ListeGlobale.xls").Worksheets("General").Range("B3:F3").Copy _
    Destination:=Workbooks("ListeInformatique.xls").Worksheets("Fournitures").Range("B3:F3")
    'Recherche de la dernière ligne renseignée
    DerLigneCopie = Workbooks("ListeInformatique.xls").Worksheets("Fournitures").Range("B3").SpecialCells(xlCellTypeLastCell).Row
    'Tu remplaces la ligne suivante par un tableau des types
    '... et tu crées une boucle sur la dimension du tableau des types
    '... auquel cas, tu devras également créer un tableau sur les noms de fichiers et de feuilles    TypeCherché = "Fournitures"
    'Entrée dans la boucle (là je cherche 1 seul type)
    plage = Workbooks("ListeGlobale.xls").Worksheets("General").Range("C3" & ":" & Range("C3").End(xlDown).Address).Address
    With Workbooks("ListeGlobale.xls").Worksheets("General").Range(plage)
        'Je cherche la première occurence AVANT de rentrer dans la boucle de recherche des données suivantes
        Set C = .Find(TypeCherché, LookIn:=xlValues)
        If Not C Is Nothing Then
            Do
                NewLigne = C.Row
                plage = "B" & C.Row & ":" & "F" & C.Row
                DerLigneCopie = DerLigneCopie + 1
                Workbooks("ListeGlobale.xls").Worksheets("General").Range(plage).Copy _
                Destination:=Workbooks("ListeInformatique.xls").Worksheets("Fournitures").Range("B" & DerLigneCopie & ":" & "F" & DerLigneCopie)
                    Set C = .FindNext(C)
            Loop While (Not C Is Nothing) And C.Row > NewLigne
        End If
    End With
    Set C = Nothing
End Sub

Tu dis
A+