Discussion :

[charlesj]

Bonjour,

Je sais que vous n'êtes pas une société de services en ingénierie informatique. Mais j'ai vraiment besoin de votre aide.

Voici
Je souhaite que sur une feuille il y ait un bouton en cliquant sur ce dernier il me propose d'ouvrir un classeur, puis recherche dans la première colonne 2015. Pour chaque ligne où dans la 1ère colonne il y a 2015 la sélectionner et la copier dans mon classeur d'origine sur une autre feuille que celle où il y a le bouton. puis répéter l’opération pour 10 fichiers différents que je souhaite choisir comme lorsqu'on utilise Application.Workbooks.Open Application.GetOpenFilename().
je suppose utiliser :

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
 
Public FeuilleSynFi As Worksheet
Public Const SynFi_NumColRubrique As Integer = 1
Public ListeFE As Worksheet
 
Sub Upload_synth()
       Application.Workbooks.Open Application.GetOpenFilename()
          If (FichierSelectionne = "") Then
              ' Pas de fichier sélectionné
              AbandonneTraitement = True 
 
          Else
For j = 1 To 100000
    If (FeuilleSynFi.Cells(SynFi_NumLig, SynFi_NumColRubrique).Value = "2015" & "*") Then
                Rows(ActiveCell.Row).Select
                Selection.Copy
                Selection.Paste Destination:=ListeFE.Cells(LastRow, j + 1)
       Next for
 End If
 
End Sub

Mais je n'y arrive pas du tout.

Merci de votre aide.

[Philippe Tulliez]

Bonjour,
Il y a deux parties dans ta question.
D'une part la sélection d'un classeur par une boîte de dialogue et d'autre part faire une exportation de données se trouvant dans une liste de données suivant condition.
Pour cette dernière, la réponse est dans le filtre élaboré d'excel. Un tutoriel à lire sur le sujet Les filtres avancés ou élaborés dans Excel.
Pour la première partie de ta question, une solution parmi d'autres est la méthode GetOpenFilename
Exemple

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
Sub t()
 Dim wkbName As Variant
 wkbName = Application.GetOpenFilename("Classeur Excel (*.xls), *.xls")
 If wkbName <> False Then MsgBox "Je vais ouvrir le fichier " & wkbName
End Sub

Il faut remplacer, la fonction MsgBox par la méthode Open
GetOpenFileName a un argument MultiSelect pour faire de la multi-sélection

[charlesj]

Super merci de votre réactivité

Pour le Filtre avancé, c'est une fonction qu je ne connaissais pas merci de me la faire découvrir.

Par contre je ne peux m'en servir car je ne peux pas créer de "zone de critères." Le fichier source est un extract d'un progiciel qui doit rester inchangé. je dois copier-coller les lignes où la première cellule en colonne A commence par 2015 et ceux pour (j'ai recompté j'avais oublié plein de dossier) pour 32 fichiers.

[Philippe Tulliez]

Bonjour,

Par contre je ne peux m'en servir car je ne peux pas créer de "zone de critères." Le fichier source est un extract d'un progiciel qui doit rester inchangé. je dois copier-coller les lignes où la première cellule en colonne A commence par 2015 et ceux pour (j'ai recompté j'avais oublié plein de dossier) pour 32 fichiers.

Rien ne t'empêche de créer une feuille de travail où tu importes les données provenant du progiciel et ensuite créer une zone de critères qui ne doit bien évidemment pas être nécessairement dans la même feuille.

[charlesj]

Les extracts sont fait par une personnes pour tout le monde.
Le truc serait d'importer les (32) extracts complet dans mon fichier afin d'appliquer mon filtre avancé? si oui est-ce possible par 1 bouton?

[Philippe Tulliez]

Bonjour,

Tout est possible en informatique, c'est une question de temps et d'argent.
Attention qu'il faut tout de même tenir compte que la limite du nombre d'enregistrements depuis la version 2007 est de 1.048.576 lignes

[charlesj]

Merci de votre patience et de votre aide c'est plus que très aimable de votre part.

On revient donc au problème du départ de l'importation de donnés avec un critère vers un autre classeur.

[Philippe Tulliez]

Bonjour,

Cela signifie donc que l'ensemble des 32 fichiers représente plus de 1.048.576 lignes ?
Rien n'empêche d'enclencher une procédure qui va extraire un par un les 32 fichiers et faire 32 filtres avancés en les ajoutant à une liste de données;
Une autre option serait de lire les fichiers d'extractions par une variable tableau mais comme tu ne dis pas quel format ont les fichiers d'extractions ni le nombre de lignes totales que représentent les fichiers extraits car on pourrait placer les lignes extraites sur plusieurs feuilles.

[charlesj]

Bonjour,

Ce sont des fichiers évolutifs, je ne sais pas combien de lignes j'ai au total.

Alors voilà j'ai avancé à partir d'une autre macro que j'ai modifié, mais là ça fait un balayage des fichiers. je suis donc obligé de les réunir dans un dossier où sera mon fichier final si quelqu'un a la solution pour aller chercher fichier par fichier sans qu'ils soient tous dans le même dossier (soit 32 fichiers à ce jour)

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
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
Public ListeFe As Worksheet
Public ComparaisonFe As Worksheet
 
Public Const Liste_NumLigDeb As Integer = 2
 
Public Const ListeBases_NumLigDeb As Integer = 3
 
Public Const ListeBases_NumColCodeProjet As Integer = 1
Public Const ListeBases_NumColLast As Integer = 26
 
 
Public Const Appli_NumLigMax As Long = 200000
 
Sub Upload()
' Cette procédure a pour but de concaténer les Listes
 
    Application.Calculation = xlManual
 
    Set ListeFe = ThisWorkbook.Worksheets("Liste")
    Set ComparaisonFe = ThisWorkbook.Worksheets("Comparaison")
 
 
    Repertoire = ThisWorkbook.Path
    Nom_Fichier = ThisWorkbook.Name
    Liste_NumLig = Liste_NumLigDeb
    j = 3
 
 
    Application.EnableEvents = False
    Application.DisplayAlerts = False
 
    ' Suppression des lignes du Liste
    Range(ListeFe.Cells(Liste_NumLigDeb, 1), ListeFe.Cells(Appli_NumLigMax, ListeBases_NumColLast)).ClearContents
 
 
    ' balayage de tous les fichiers du répertoire
    FichS = Dir(Repertoire & "\*.xls*")
    While ((FichS <> "") And (Left(FichS, 1) <> "~"))
        j = j + 1
        'ComparaisonFe.Cells(j, 1).Value = FichS
 
        If (FichS = Nom_Fichier) Then
            FichS = Dir
        Else
            FichS_nom_complet = Repertoire & "\" & FichS
            Workbooks.Open FichS_nom_complet
 
            Dim i As Integer
 
            For i = 1 To Worksheets.Count
                If (Worksheets(i).Name = "Synthese financiere") Then
                    ListeBases_NumLig = ListeBases_NumLigDeb
                    While (Worksheets(i).Cells(ListeBases_NumLig, ListeBases_NumColCodeProjet) <> "")
                        ListeBases_NumLig = ListeBases_NumLig + 1
                    Wend
 
                    Range(Worksheets(i).Cells(ListeBases_NumLigDeb, 1), Worksheets(i).Cells(ListeBases_NumLig, ListeBases_NumColLast)).Select
                    Selection.Copy
                    ListeFe.Activate
                    Range(ListeFe.Cells(Liste_NumLig, 1), ListeFe.Cells(Liste_NumLig, ListeBases_NumColLast)).Select
                    ActiveSheet.Paste
                    Liste_NumLig = Liste_NumLig + ListeBases_NumLig - ListeBases_NumLigDeb
 
                End If
            Next i
            Workbooks(FichS).Close
            FichS = Dir
 
        End If
    Wend
 
    Application.EnableEvents = True
    Application.DisplayAlerts = True
 
 
Application.Calculation = xlAutomatic
End Sub

[Philippe Tulliez]

Bonjour,

si quelqu'un a la solution pour aller chercher fichier par fichier sans qu'ils soient tous dans le même dossier (soit 32 fichiers à ce jour)

Une réponse certainement dans cette discussion

[OursTortue]

Bonjour

Cela pose-t-il un problème que les fichiers soient tous dans le même répertoire? En admettant que vous connaissiez leurs chemins respectifs et qu'ils ne changent pas, il suffit de tous les copier avant d'exécuter le code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
 
Public function Copie_Fichier(Chemin_src as string, Chemin_dest as string)
 
Dim xlobj As Object
Set xlobj = CreateObject("Scripting.FileSystemObject")
 
xlobj.CopyFile Chemin_src, Chemin_dest, True
 
Set xlobj = Nothing
 
end function

Ensuite tu appelles tes fichiers comme ça :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
 
Dim Chemin_source as string
Dim Chemin_destination as string
 
Chemin_source = "C:\Dossier1\Dossier2\Fichier.xls"
Chemin_destination = "C:\Dossiertravail\Fichier.xls"
 
Copie_Fichier(Chemin_source, Chemin_destination)

Il faut rajouter aussi une protection pour vérifier que tes fichiers ne soient pas actuellement utilisés.

Sinon pour la copie de données, il vaut mieux éviter les .select et plutôt passer par des array qui seront beaucoup plus rapides et qui se font en plus en toute transparence.