Extraction de certaines données via macro

Version imprimable

22/06/2013, 13h14
benadry

3 pièce(s) jointe(s)

Extraction de certaines données via macro

Bonjour,

Je souhaiterais, à partir d'une macro ou d'une formule, extraire une partie des colonnes d'un fichier dont les données répondent à certaines conditions et alimenter un fichier préexistant.

Je suis débutant et ne sais pas trop comment m'y prendre.

Pour l'instant, j'ai un classeur1 dans lequel l'utilisateur entre le nom du fichier qui servira d'extraction. L'idée serait qu'en cliquant sur le bouton contenu dans ce classeur1, les données d'un 2e classeur soient automatiquement extraites vers un autre classeur si elles répondent à certaines conditions.

Merci d'avance pour votre aide.

Cordialement.
24/06/2013, 10h26
benadry

Bonjour,

Désolé de relancer le forum, mais j'ai cherché ce week-end avec des fonctions comme DECALER et SI et ça ne donne rien.
Je ne vois pas comment je peux procéder.

Merci d'avance pour votre aide.

Cordialement.

Bonjour,

Je me suis creusé les méninges et j'ai surtout consulté des forums, pour un résultat qui n'est pas fantastique !!

Je n'arrive pas à ouvrir le fichier comme indiqué ci-dessus. J'ai essayé 4 macros successives (ci-dessous) et j'ai toujours la même erreur :

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
Sub Ouvrir_Excel()
 
'Ne marche pas
Chemin = "G:\CPT\Activités service compta\Gestion des créances et oppositions\Année 2013\Indus\Suivi des notifications d'indus\"
 
Workbooks.Open (Chemin + [F6])
 
End Sub
 
Sub Macro()
 
'Ne marche pas
Dim Dossier As String, Fichier As String, Chemin As String
Dossier = "G:\CPT\Activités service compta\Gestion des créances et oppositions\Année 2013\Indus\Suivi des notifications d'indus\"
Fichier = [F6]
Chemin = Dossier & Fichier
 
Workbooks.Open Filename:=Chemin
 
End Sub
 
 
Sub Macro3()
 
'Ne marche pas
Workbooks.Open Filename:="G:\CPT\Activités service compta\Gestion des créances et oppositions\Année 2013\Indus\Suivi des notifications d'indus\" & "journeedu21062013" & ".xls"
 
End Sub
 
Sub Macro4()
 
 
[F6] = ActiveWorkbook.Name
Workbooks.Open Filename:="G:\CPT\Activités service compta\Gestion des créances et oppositions\Année 2013\Indus\Suivi des notifications d'indus\"
Windows(F6).Activate
 
End Sub

J'ai ensuite essayé d'écrire quelque chose, mais je suis loin d'être sûr que ça marche.

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
Sub Extraction_données()
 
    Set wbcible = "G:\BUREAU\Documents\Indus\Relances.xlsx"
    Set wbsource = Workbooks.Open("G:\BUREAU\Documents\[F6]")
wbsource .Activate
 
' If R = 0 and V = "RLC" Then Exit Sub (ici, il faut dire "quand la colonne R est égale à 0 ou la colonne V à RLC, il n'y a rien à faire.
 
Else 'dans le cas contraire, copie les colonnes de A à W du classeur source dans le classeur cible
    With wbsource
        ActiveSheet.Columns("A:A").Copy wbcible.Sheets("Relances.xlsx").Columns("A:A")
        ActiveSheet.Columns("B:B").Copy wbcible.Sheets("Relances.xlsx").Columns("B:B")
        ActiveSheet.Columns("C:C").Copy wbcible.Sheets("Relances.xlsx").Columns("C:C")
        ActiveSheet.Columns("D:D").Copy wbcible.Sheets("Relances.xlsx").Columns("D:D")
        ActiveSheet.Columns("E:E").Copy wbcible.Sheets("Relances.xlsx").Columns("E:E")
        ActiveSheet.Columns("F:F").Copy wbcible.Sheets("Relances.xlsx").Columns("F:F")
        ActiveSheet.Columns("G:G").Copy wbcible.Sheets("Relances.xlsx").Columns("G:G")
        ActiveSheet.Columns("H:H").Copy wbcible.Sheets("Relances.xlsx").Columns("H:H")
        ActiveSheet.Columns("I:I").Copy wbcible.Sheets("Relances.xlsx").Columns("I:I")
        ActiveSheet.Columns("J:J").Copy wbcible.Sheets("Relances.xlsx").Columns("J:J")
        ActiveSheet.Columns("K:K").Copy wbcible.Sheets("Relances.xlsx").Columns("K:K")
        ActiveSheet.Columns("L:L").Copy wbcible.Sheets("Relances.xlsx").Columns("L:L")
        ActiveSheet.Columns("M:M").Copy wbcible.Sheets("Relances.xlsx").Columns("M:M")
        ActiveSheet.Columns("N:N").Copy wbcible.Sheets("Relances.xlsx").Columns("N:N")
        ActiveSheet.Columns("O:O").Copy wbcible.Sheets("Relances.xlsx").Columns("O:O")
        ActiveSheet.Columns("P:P").Copy wbcible.Sheets("Relances.xlsx").Columns("P:P")
        ActiveSheet.Columns("Q:Q").Copy wbcible.Sheets("Relances.xlsx").Columns("Q:Q")
        ActiveSheet.Columns("R:R").Copy wbcible.Sheets("Relances.xlsx").Columns("R:R")
        ActiveSheet.Columns("S:S").Copy wbcible.Sheets("Relances.xlsx").Columns("S:S")
        ActiveSheet.Columns("T:T").Copy wbcible.Sheets("Relances.xlsx").Columns("T:T")
        ActiveSheet.Columns("U:U").Copy wbcible.Sheets("Relances.xlsx").Columns("U:U")
        ActiveSheet.Columns("V:V").Copy wbcible.Sheets("Relances.xlsx").Columns("V:V")
        ActiveSheet.Columns("W:W").Copy wbcible.Sheets("Relances.xlsx").Columns("W:W")
    End With
    Range("A2").Select
 
End Sub

Si quelqu'un pouvait jeter un coup d'oeil à tout ça, ce serait très sympathique. Mon niveau en macro est très très limité et je patauge complètement.

Merci d'avance.

Cordialement.

25/06/2013, 17h23
Dubbleu

Hey
Je suis sur un problème similaire au tiens !! je te préviens si je trouve une solution (ou si on m'en propose une sur un autre topic)

Bonjour,

En utilisant la discussion suivante (http://www.developpez.net/forums/d11...dition-resolu/), j'ai un peu avancé sur mon projet.

Voici ce que ça donne :
Code:

1 2 3 4 5 6 7 8 Sub Ouvrir_Excel() Chemin = "G:\BUREAU\Documents\...\Suivi indus\" ext = ".xls" nom = ThisWorkbook.Sheets(1).Range("f6").Value Workbooks.Open (Chemin & nom & ext) End Sub
A ce niveau, tout fonctionne.

Voici la 2e macro :
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 Sub Extraire_donnees() Dim wbSource As Workbook Dim wbCible As Workbook Dim CelSource As Range Dim CelCible As Range Dim shCible As Worksheet Dim Lig As Long Dim Col As String Dim NbrLig As Long Dim NumLig As Long Chemin = "G:\BUREAU\Documents\...\Suivi indus\" ext = ".xls" nom = ThisWorkbook.Sheets(1).Range("f6").Value Set wbSource = Workbooks.Open(Chemin & nom & ext) Workbooks.Open "G:\BUREAU\Documents\...\Suivi indus\Relances.xlsm" Set wbCible = Workbooks("Relances.xlsm") Set shCible = wbCible.Worksheets("Total des indus non soldés") wbSource.Activate wbCible.Worksheets("Total des indus non soldés").Activate ' feuille de destination Col = "R" ' colonne de la donnée non vide à tester NumLig = 2 With wbSource ' feuille source NbrLig = .Cells(65536, Col).End(xlUp).Row For Lig = 3 To NbrLig If .Cells(Lig, Col).Value <> "0" Then .Range("A" & Lig & ":W" & Lig).Copy NumLig = NumLig + 1 Cells(NumLig, 1).Select ActiveSheet.Paste End If Next End With End Sub
Ce n'est sans doute pas très "beau", mais ça semble être un bon début, sauf que j'ai une erreur d'exécution 438 "propriété ou méthode non géré par cet objet" à la ligne

Code:

NbrLig = .Cells(65536, Col).End(xlUp).Row

Par ailleurs, je souhaiterais rajouter une autre condition dans la colonne V et je ne sais pas comment faire. J'ai essayé de recopier la condition de la colonne R en l'adaptant, mais la macro bloque, car il y a une succession de "for", si j'ai bien compris.
Enfin, je voudrais fermer le fichier source une fois le travail réalisé.

Quelqu'un aurait-il une idée, car je tourne vraiment en rond ?

Merci d'avance.

Cordialement.

26/06/2013, 18h24
casefayere
Bonsoir,

Apprends-toi à mettre des balises pour éditer tes codes, cliques sur "#", après avoir selectionné le code,
quand tu fais :
Code:

1 2 3 4 5 6 ... Col = "R" ' colonne de la donnée non vide à tester NumLig = 2 With wbSource ' feuille source NbrLig = .Cells(65536, Col).End(xlUp).Row .....
"Col" ne sert pas à grand chose, pourquoi pas :
Code:

1 2 3 4 NumLig = 2 With wbSource ' feuille source NbrLig = .range("R" & .Rows.Count).End(xlUp).Row
attention, je n'ai pas regardé ni analysé tout ton code, je réponds juste pour ta dernière erreur signalée
26/06/2013, 18h30
benadry

Bonjour,

Un grand merci pour le code.

Le problème est que je ne suis pas du tout du tout un spécialiste des macros et que je ne coprends pas ce que je fais. En tout cas c'est noté.

Et pour mes autres questions, désolé d'insizster, mais quelqu'un aurait-il des suggestions ?

merci d'avance.

Cordialement.
26/06/2013, 18h38
casefayere
Citation:

Par ailleurs, je souhaiterais rajouter une autre condition dans la colonne V et je ne sais pas comment faire

a toi de mettre ta condition :
Code:

1 2 3 4 5 ... For Lig = 3 To NbrLig If .range("R" & Lig) <> "0" and .range("V" & Lig) > "tatatata" Then .Range("A" & Lig & ":W" & Lig).Copy ....
Peut-être !
27/06/2013, 11h08
benadry

Bonjour,

Merci encore pour le code. On progresse !

J'ai cependant une erreur d'exécution 438 (propriété ou méthode non gérée par cet objet" à la ligne :

Code:

NbrLig = .Range("R" & .Rows.Count).End(xlUp).Row

Et évidemment, je ne comprends pas du tout pourquoi !!

Merci d'avance pour toute aide.

Bien cordialement.
02/07/2013, 22h20
AlainTech

Bonjour,

wbSource est un classeur, pas une feuille.

Et un classeur n'a pas de propriété Range.
03/07/2013, 05h47
casefayere
Bonjour le forum,AlainTech,benadry.

quand tu écris :
Code:

1 2 3 4 5 .... nom = ThisWorkbook.Sheets(1).Range("f6").Value Set wbSource = Workbooks.Open(Chemin & nom & ext) ....
et quand AlainTech répond :

Citation:

wbSource est un classeur, pas une feuille.

Ce n'est ni une feuille, ni un classeur (meme si "Dim wbSource As Workbook") car "nom" représente un range dans sheets(1), c'est une erreur de syntaxe, ça ne serait pas :
Code:

1 2 3 4 5 6 7 8 ..... Dim wbSource As WorkSheet ..... ext = ".xls" nom = ThisWorkbook.Sheets(1) Set wbSource = Workbooks.Open(Chemin & nom & ext) ....
03/07/2013, 21h56
AlainTech

Bonjour,

C'est le nom du classeur à ouvrir qui est dans ThisWorkbook.Sheets(1).Range("f6").

Donc, pas d'erreur de syntaxe et wbSource est bien un classeur.
08/07/2013, 08h28
benadry

Bonjour à tous,

J'avoue ne pas avoir compris vos derniers échanges (désolé, mais vous voyez les limites de mes maigres compétences !).

Quand j'utilise le code contenu dans le message, le fichier source et le fichier cible s'ouvrent, mais j'ai une erreur 438 "propriété ou méthode non gérée par cet objet" à la ligne

Code:

NbrLig = .Range("R" & .Rows.Count).End(xlUp).Row

En revanche, si j'applique la solution de Dom, j'ai la même erreur, mais en amont à la ligne

Code:

nom = ThisWorkbook.Sheets(1)

Donc, je sèche toujours autant !

Merci d'avance pour votre aide, en tout cas.

Cordialement.

Bonjour à tous,

J'ai passé une bonne partie de la journée sur des forums et je tourne complètement en rond.

Voici mon code tel qu'il est à l'heure actuelle :
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 Sub Extraire_donnees() Dim Lig As Long Dim Col As String Dim NbrLig As Long Dim NumLig As Long Dim Chemin As String Dim Ext As String Dim Nom As String Chemin = "G:\BUREAU2\Année 2013\Indus\Suivi des notifications d'indus\Journées\" Ext = ".xls" Nom = ThisWorkbook.Sheets(1).Range("G6").Value Workbooks.Open (Chemin & Nom & Ext) Workbooks.Open "G:\BUREAU2\Année 2013\Indus\Suivi des notifications d'indus\Liste des indus créés à compter de 052013.xlsm" Sheets("Total des indus non soldés").Activate NumLig = 2 With Sheets("Total des indus non soldés").Activate ' feuille source NbrLig = .Range("R" & .Rows.Count).End(xlUp).Row For Lig = 3 To NbrLig If .Range("R" & Lig) <> "0" Or .Range("V" & Lig) <> "RLC" Then .Range("A" & Lig & ":W" & Lig).Copy NumLig = NumLig + 1 Cells(NumLig, 1).Select ActiveSheet.Paste End If Next End With Workbooks.Close End Sub
J'ai voulu enlever les définitions de variables wbSource ... qui, je pense, "polluaient" le tout.

Le fichier source et le fichier cible s'ouvrent :lol:

Puis, rien ne va plus :cry: : j'ai toujours une erreur à la ligne

Code:

NbrLig = .Range("R" & .Rows.Count).End(xlUp).Row

Cette fois, c'est une erreur d'exécution 424 "objet requis".

Quelqu'un aurait-il une idée pour, enfin, faire fonctionner cette macro qui me porte vraiment sur les nerfs ?

Merci d'avance.

Cordialement.

Bonjour,

Il faut absolument que tu te documentes au moins pour comprendre ce que tu fais ou recopie.

Code:

Set wbSource = Workbooks.Open(Chemin & nom & ext)

Ici tu instancie avec l'instruction SET, un classeur, ce classeur à des propriétés par exemple son chemin complet ... (propriété FullName...)

Le classeur n'a pas de propriété de cellule, c'est la feuille qui en a.
Donc tu pourrai instancier par exemple la première feuille en faisant :

Code:

Set wbFeuille1Source = wbSource.Worksheets(1)

Ensuite tu utilises le WITH qui est intéressant car permet d'accéder plusieurs fois aux propriètés définies. Les propriétés de cellule qui font parties des feuilles sont accessibles par le mot CELLS ou RANGE et là tu peux utiliser toutes les propriétés qui dépendent de ta feuille :
Code:

1 2 3 4 5 With wbFeuille1Source' La c'est bien la feuille source et non le classeur NbrLig = .Range("R" & .Rows.Count).End(xlUp).Row .Cells(Lig, Col).Value = "TEST" '... End with
Tu pourrai aussi faire sans le with en ecrivant le code ci-dessus mais en plus lourd :
Code:

1 2 NbrLig = wbFeuille1Source.Range("R" & wbFeuille1Source.Rows.Count).End(xlUp).Row wbFeuille1Source.Cells(Lig, Col).Value = "TEST"
Tu peux essayer dans un nouveau classeur, juste en tapant un point (".") dans la ligne en dessous des with, tu verra automatiquement dans l'éditeur la liste des propriétés s'afficher :
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 Sub test() Dim Sh As Worksheet, wb As Workbook Set wb = ThisWorkbook With wb MsgBox .FullName MsgBox .Sheets.Count End With Set Sh = wb.Worksheets(1) Sh.Cells(1, 1).Value = "Cellule A1" With Sh .Range("B1").Value = "Cellule B1" .Cells(3, 1).Value = "Cellule A1" ' non je déconne c'est A3 ! MsgBox .Cells(4, 1).Address End With Set wb = Nothing Set Sh = Nothing End Sub

Bonjour,
Si j'ai bien compris, il s'agit d'exporter des données se trouvant dans une feuille d'un classeur (que l'on appelle source) vers une autre feuille d'un classeur (appeler cible) et ce suivant des critères.
C'est un cas typique pour le filtre avancé d'excel
Voici un exemple qui se résume à quelques lignes (il y a en a plus pour définir les noms des constantes et des variables objets décomposées pour la compréhension (Peut donc être plus léger).
Dans cet exemple les plages source et cible commence à la ligne 1. Les critères se trouvent dans la feuille [Param] du classeur où se trouve le code VBA (ThisWorkbook)
Il s'agit d'exporter les personnes de Sexe masculin (M en colonne 6 (Sexe)) et habitant une maison (colonne 9 (Logement))
Il suffit de modifier la valeur des constantes, créer une feuille [Param] dans le classeur où se trouve le code VBA et coller le code ci-dessous dans une nouveau module.
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 29 30 31 32 33 34 35 Option Explicit ' Constantes à modifier Const FolderSource As String = "Z:\Tests\Population\" Const FolderTarget As String = "z:\tests\" Const FileNameSource As String = "ListeCommunale.xls" Const FileNameTarget As String = "Conso.xls" Const SheetSource As String = "db" Const SheetTarget As String = "Export" Sub Main() Dim wkbSource As Workbook, wkbTarget As Workbook Dim SourceName As String Dim rngData As Range, rngExport As Range, rngCriteria As Range Dim Formula As String ' Variable contenant la formule des critères Set wkbSource = Workbooks.Open(FolderSource & FileNameSource) Set wkbTarget = Workbooks.Open(FolderTarget & FileNameTarget) ' Zone data, Export et Critère Set rngData = wkbSource.Worksheets(SheetSource).Range("A1").CurrentRegion Set rngExport = wkbTarget.Worksheets(SheetTarget).Range("A1") Set rngCriteria = ThisWorkbook.Worksheets("Param").Range("A1:A2") ' Construction de la formule des critères ' But -> "=AND([ListeCommunale.xls]db!RC[8]=""Maison"",[ListeCommunale.xls]db!RC[5]=""M"")" SourceName = "[" & FileNameSource & "]" & SheetSource & "!" Formula = "=AND(" & SourceName & "RC[8]=""Maison""" Formula = Formula & "," & SourceName & "RC[5]=""M"")" ' Alimentation de la zone des critères rngCriteria(1) = "Criteria" ' Ligne 1 rngCriteria(2) = Formula ' Ligne 2 ' Exportation par le filtre avancé With rngData: .AdvancedFilter xlFilterCopy, rngCriteria, rngExport: End With ' Enlève la formule de la zone des critères et ferme les fichiers Source rngCriteria(2).Clear: wkbSource.Close ' Libère les variables objets Set wkbSource = Nothing: Set wkbTarget = Nothing Set rngData = Nothing: Set rngExport = Nothing: Set rngCriteria = Nothing End Sub
Pour en savoir plus sur sur Les filtres avancés ou élaborés dans Excel

Bonjour,

A Aalex 38 : ce n'est pas faute de me documenter. Le problème est de savoir où. On trouve tellement de choses partout, du bon, comme du moins bon que ce n'est pas évident. En plus, chacun a sa spécialité et les macros ne sont pas la mienne !!! Pour tout expliquer, je galère pour essayer d'automatiser des tâches pour des collègues, afin d'éviter que chacun ne "touche" aux différents classeurs (je sais de quoi je parle, j'ai testé et ça a tourné au désastre, donc macro !). Je sais bien qu'il serait plus facile de faire des copier-coller dans le tableau de destination en utilisant les filtres ...

A Monsieur Tulliez : merci pour votre contribution. J'ai complètement modifié mon code en fonction de ce que vous m'avez préconisé et j'ai encore pas mal de questions !!

Voici le code à l'heure actuelle :
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 Option Explicit ' Constantes Const FolderSource As String = "G:\Répertoire d'origine XXXX\" Const FolderTarget As String = "G:\Répertoire de destination YYYY \" Const FileNameSource As String = ThisWorkbook.Sheets(1).Range("G6").Value & ".xls" Const FileNameTarget As String = "Liste des indus créés à compter de 052013.xlsm" Const SheetSource As String = "A" Const SheetTarget As String = "Total des indus non soldés" Sub Main() Dim wkbSource As Workbook, wkbTarget As Workbook Dim SourceName As String Dim rngData As Range, rngExport As Range, rngCriteria As Range Dim Formula As String ' Variable contenant la formule des critères Set wkbSource = Workbooks.Open(FolderSource & FileNameSource) Set wkbTarget = Workbooks.Open(FolderTarget & FileNameTarget) ' Zone data, Export et Critère Set rngData = wkbSource.Worksheets(SheetSource).Range("A2").CurrentRegion Set rngExport = wkbTarget.Worksheets(SheetTarget).Range("A1") Set rngCriteria = ThisWorkbook.Worksheets("Param").Range("A2:A3") ' Construction de la formule des critères ' Indication des critères : colonne R (18) <> 0 et colonne V(22) <> "RLC" SourceName = "[" & FileNameSource & "]" & SheetSource & "!" Formula = "=AND(" & SourceName & "RC[18]<>""0""""" Formula = Formula & "," & SourceName & "RC[22]<>""RLC"")" ' Alimentation de la zone des critères rngCriteria(1) = "Criteria" ' Ligne 1 rngCriteria(2) = Formula ' Ligne 2 ' Exportation par le filtre avancé With rngData: .AdvancedFilter xlFilterCopy, rngCriteria, rngExport: End With ' Enlève la formule de la zone des critères et ferme les fichiers Source rngCriteria(2).Clear: wkbSource.Close ' Libère les variables objets Set wkbSource = Nothing: Set wkbTarget = Nothing Set rngData = Nothing: Set rngExport = Nothing: Set rngCriteria = Nothing End Sub
Voilà ce que j'ai fait et ce qui me pose problèmes :
- Const FolderSource désigne l'emplacement du répertoire d'origine : OK
- Const FolderTarget désigne l'emplacement du répertoire source : OK
- Const FileNameSource désigne le fichier de départ. Or, ici, elle varie en fonction de la valeur qui est dans la cellule G6 du classeur dans lequel se trouve la macro (ThisWorkbook.Sheets(1).Range("G6").Value & ".xls". Et là, ça bug !

J'ai voulu continuer en désignant un nom de fichier de départ "fixe".
Ce que j'ai compris (a priori !), c'est que dans les critères du filtre avancé se trouvent dans "Set rngCriteria = ThisWorkbook.Worksheets("Param").Range("A2:A3")" où j'indique en A2 = R2 <> 0 et en A3 = V2 <> "RLC".
Ce sont les mêmes critères que je retrouve ensuite sous la forme :
Formula = "=AND(" & SourceName & "RC[18]<>""0"""""
Formula = Formula & "," & SourceName & "RC[22]<>""RLC"")"

Ai-je bien compris ?

Par ailleurs, j'ai indiqué "Set rngData = wkbSource.Worksheets(SheetSource).Range("A2").CurrentRegion", puisque les données à exporter commencent à la cellule A2. Suis-je toujours bon, même si je ne comprends pas très bien ce que veut dire "CurrentRegion".

Enfin, là où j'ai un problème, c'est avec les cellules de destination, puisqu'il s'agit de la première ligne vide du classeur de destination, donc la cellule A2648 aujourd'hui, mais 2648 + x lignes demain, et encore plus après-demain. Le nombre de lignes augmente de jour en jour, mais sans que je sache préalablement de combien. Je ne sais pas comment faire !

Enfin, quant au "0" de la colonne R ci-dessus, il est au format standard dans le fichier d'origine. Je pense que j'ai intérêt à créer une macro qui le transforme en chiffre, de manière à ne considérer le "0" que comme un chiffre dans la suite des formules et donc sans les "". Suis-je dans le bon ?

Merci d'avance pour votre aide en tout cas.

Bien cordialement.

Benadry

10/07/2013, 11h34
Philippe Tulliez
Bonjour,
Si les constantes (en tête de module) sont bien remplies il n'y a pas lieu de modifier les autres lignes de code.
Une constante doit contenir une valeur constante mais pas une donnée variable.
Ceci est mauvais

Code:

Const maVariable As String = ThisWorkbook.Worksheets(1).Name

Ceci est correct

Code:

Const maVariable As String = "maFeuille"

La seule ligne à modifier est la ligne qui construit les critères (Formula=)

Citation:

Par ailleurs, j'ai indiqué "Set rngData = wkbSource.Worksheets(SheetSource).Range("A2").CurrentRegion", puisque les données à exporter commencent à la cellule A2. Suis-je toujours bon, même si je ne comprends pas très bien ce que veut dire "CurrentRegion".

Oui, si les en-têtes de colonnes se trouve en A2

Citation:

Ce que j'ai compris (a priori !), c'est que dans les critères du filtre avancé se trouvent dans "Set rngCriteria = ThisWorkbook.Worksheets("Param").Range("A2:A3")" où j'indique en A2 = R2 <> 0 et en A3 = V2 <> "RLC".

Il n'y a rien a indiquer, c'est le programme qui écrit la formule et l'étiquette de colonne
Code:

1 2 3 ' Alimentation de la zone des critères rngCriteria(1) = "Criteria" ' Ligne 1 rngCriteria(2) = Formula ' Ligne 2
Je ne peux qu'abonder dans le sens de l'intervention d'Aalex_38 il faut se documenter et essayer de comprendre ce que l'on fait.
Sur ce site il y a un tas de tutoriels extrêmement bien fait et le but de ce forum est de s'entraider mais pas de faire le travail à la place d'un autre.
Un minimum d'investissement est nécessaire sinon il faut passer par des prestataires de services.

Bonjour,

Pour répondre à Monsieur Tulliez et, sans vouloir polémiquer, je ne me suis pas vu comme un "pique-assiettes".

Chacun sa spécialité, vous en conviendrez. Le développement VBA est loin d'être la mienne, je tâtonne donc, très maladroitement.
Je pense (mais c'est mon avis) que si vous passez quelques minutes à regarder ce qui ne va pas dans le code que vous m'avez donné et que je tente d'adapter, ce sera beaucoup plus efficient que si je passe des heures à galérer !!
Pour moi, c'est de l'entraide.

Pour en revenir au code, j'ai donc travaillé dessus encore pendant plusieurs heures (= minimum d'investissement), notamment en regardant votre tutoriel sur les filtres avancés et j'ai encore des difficultés.

Si vous aviez donc l'amabilité d'y regarder, je vous en serais très reconnaissant.

J'ai ajouté quelques commandes supplémentaires pour changer le format de la colonne "R", qui n'était pas toujours en nombre (l'applicatif qui convertit quotidiennement en excel et sur lequel je n'ai pas la main est quelquefois capricieux). Pour les mêmes raisons de caprice, j'ai fait en sorte que la feuille du classeur source soit renommée de la même façon ("A" en l'occurrence).
J'ai également prévu un enregistrement et une fermeture des deux fichiers après exécution de la macro.

Le problème est que j'ai deux conditions alternatives : ou la valeur "0" en colonne R ou la valeur "RLC" en colonne V. Dans ces cas-là, les données ne sont pas extraites.
Au lieu de mettre "Formula = "=AND(" & SourceName & "RC[8]=""Maison"""
Formula = Formula & "," & SourceName & "RC[5]=""M"")"" comme dans votre exemple, j'ai donc mis ""Formula = "=OR" puis les critères.
J'ai essayé avec un seul critère et, comme vous le disiez, dans la feuille"Param", la macro indique automatiquement Criteria en A1 et le contenu de la formule en A2.
En revandche, quand j'essaie de mettre les deux critères, ça ne fonctionne pas, alors que j'ai les mêmes rngDate, rngExport, rngCriteria que vous (ce qui me semble cohérent, puisque vous avez également deux critères dans votre exemple).

Comme la macro n'est jamais allée plus loin, je ne sais pas ce que donne la suite. Mais, je pense qu'il va y avoir un problème avec le fichier de destination puisque je ne veux pas écraser les lignes précédfentes, mais me placer sous la dernière ligne remplie. Et là, j'avoue que je ne sais pas quoi faire.

Voici le code (je ne sais pas comment le mettre en format code, ni faire des citations comme vous le faites) :
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 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 Option Explicit ' Constantes Const FolderSource As String = "G:\CPT\Machin\" Const FolderTarget As String = "G:\CPT\Machin\Truc\" Const FileNameTarget As String = "Liste des indus créés à compter de 052013.xlsm" Const SheetSource As String = "A" Const SheetTarget As String = "Total des indus non soldés" Sub Extraire_donnees() Dim wkbSource As Workbook, wkbTarget As Workbook, wkbsheet As Worksheet Dim SourceName As String Dim rngData As Range, rngExport As Range, rngCriteria As Range Dim Formula As String ' Variable contenant la formule des critères Dim Ext As String Dim Nom As String Nom = ThisWorkbook.Sheets(1).Range("G6").Value Ext = ".xls" Set wkbSource = Workbooks.Open(FolderSource & Nom & Ext) ' Renommer la 1ère feuille du fichier wbkSource en "A" If wkbsheet.Name <> "A" Then wkbsheet.Name = "A" End If ' Changement du format de la colonne R du fichier wbkSource Columns("R:R").Select Selection.NumberFormat = "0.00" Range("R1").Select Selection.NumberFormat = "General" Set wkbTarget = Workbooks.Open(FolderTarget & FileNameTarget) ' Zone data, Export et Critère Set rngData = wkbSource.Worksheets(SheetSource).Range("A1").CurrentRegion Set rngExport = wkbTarget.Worksheets(SheetTarget).Range("A1") ' Pas bon : il faut lui dire d'aller se mettre à la 1ere ligne non vide Set rngCriteria = ThisWorkbook.Worksheets("Param").Range("A1:A2") ' Construction de la formule des critères ' Indication des critères : colonne R (18) <> 0 ou colonne V(22) <> "RLC" SourceName = "[" & Nom & Ext & "]" & SheetSource & "!" 'Rajouté pour test : à enlever après --> ça fonctionne ' Formula = "(" & SourceName & "RC[22]<>""RLC"")" Formula = "=OR(" & SourceName & "RC[18]<>""0""" Formula = Formula & "," & SourceName & "RC[22]<>""RLC"")" ' Alimentation de la zone des critères rngCriteria(1) = "Criteria" ' Ligne 1 rngCriteria(2) = Formula ' Ligne 2 ' Exportation par le filtre avancé With rngData: .AdvancedFilter xlFilterCopy, rngCriteria, rngExport: End With ' Enlève la formule de la zone des critères rngCriteria(1).Clear ' Libère les variables objets Set wkbSource = Nothing: Set wkbTarget = Nothing Set rngData = Nothing: Set rngExport = Nothing: Set rngCriteria = Nothing ' Enregistre et ferme les deux classeurs wkbSource.Close SaveChanges:=True wkbTarget.Close SaveChanges:=True End Sub
Je renouvelle donc ma demande : si vous pouvez y regarder et me dire ce qui cloche. J'ai atteint la limite de mes compétences et, sans coup de pouce, c'est mal barré !

Merci d'avance.

Cordialement.

11/07/2013, 12h23
Philippe Tulliez
Bonjour,

Citation:

Pour répondre à Monsieur Tulliez et, sans vouloir polémiquer, je ne me suis pas vu comme un "pique-assiettes".

Monsieur est sans doute de trop, Philippe c'est très bien. Il est d'usage aussi de ce tutoyer sur les forums mais bien entendu ce n'est pas une obligation.
Comme je l'ai écrit, il faut un minimum d'investissement et surtout comprendre ce que l'on fait et si j'apporte mon aide sur ce forum, je rend ce que j'ai reçu il y a quelques années sur un autre forum.
La première chose dans le cas qui nous occupe est de comprendre l'outil Le filtre avancé d'excel qui fonctionne avec un minimum de deux zones (la zone Data, la zone de critère) et dans le cas d'une exportation une troisième zone (la zone d'exportation).
Pour bien comprendre l'outil et le traduire en code VBA, il faudrait d'abord faire des tests sans utiliser le code VBA pour comprendre son principe.
L'idéal est de commencer avec une seule feuille où se trouve les trois zones (voir les exemples du tutoriel que l'on retrouve sur le fichier à télécharger) ensuite en plaçant la zone d'exportation sur une autre feuille et ensuite en utilisant 3 feuilles en séparant les trois zones. Cela prend du temps certes mais je pense que c'est essentiel pour comprendre.

Citation:

Chacun sa spécialité, vous en conviendrez. Le développement VBA est loin d'être la mienne, je tâtonne donc, très maladroitement.

Ce n'était pas non plus au départ ma spécialité. Quand j'ai commencé à m'intéresser au VBA, j'étais commercial pour une entreprise et j'en avais assez de mettre deux heures pour faire une offre avec un fichier excel et ensuite faire du copier/coller dans Word.
J'ai donc d'abord appris à utiliser mieux les formules d'excel et à utiliser aux mieux ses outils.
J'ai passé trois mois le soir jusque très tard pour faire des tests et poser des questions sur les forums et à lire des tutos.
En final, je faisais une offre en 5 minutes d'où un bénéfice d'une journée de travail pour quatre offres. Après sept années, j'ai choisi de devenir formateur et développeur mais encore et toujours je m'améliore. Si je m'intéressais à de la plomberie ou à de la mécanique je procéderais de la même manière.

Citation:

Je pense (mais c'est mon avis) que si vous passez quelques minutes à regarder ce qui ne va pas dans le code que vous m'avez donné et que je tente d'adapter, ce sera beaucoup plus efficient que si je passe des heures à galérer !!
Pour moi, c'est de l'entraide.

Je ne vois pas vraiment les choses comme cela. J'ai largement commenté une partie de tes questions.
Faire un copier/coller de plusieurs lignes de code et de demander de regarder ce qui ne va pas ne me semble pas être dans l'esprit du forum.
En revanche afficher une ligne de code en demandant pourquoi un message d'erreur s'affiche, cela ne me pose pas de problème.
Sinon je me tire une balle dans le pied et les clients qui par hasard passeraient sur ce forum que je ne manque pas de les inviter à consulter se demanderaient pourquoi ils payent.

Citation:

Voici le code (je ne sais pas comment le mettre en format code, ni faire des citations comme vous le faites) :

C'est finalement la même chose que j'ai écrit plus haut. Un minimum d'investissement
Dominique (pseudo casefayere) te l'a indiqué dans son intervention (Post #6)

Citation:

Apprends-toi à mettre des balises pour éditer tes codes, cliques sur "#", après avoir selectionné le code,quand tu fais :

Quand on entre dans un club on observe, on lit la charte etc...
Dans l'éditeur qui te permet d'écrire tes questions, tu as des boutons au-dessus et le bouton # permet de mettre les balises de code. Soit tu cliques d'abord sur ce bouton et ensuite tu insères ton code, soit tu sélectionnes ton code et ensuite tu cliques sur ce bouton. Le bouton qui se trouve à gauche de #, insère les balises pour les commentaires. Il y a même une infobulle qui indique la fonction du bouton.
Le problème je crois c'est que tu t'es attaqué dès la première fois à un travail qui te dépasse parce-que déjà tu ne sembles pas savoir ce qu'est l'objet feuille, range, workbook etc...
Le pas à pas est la meilleure manière d'y arriver. Ce site regorge de tutoriels tous excellent mais il faut de la patience pour arriver au résultat final.

[EDIT]

Citation:

Le problème est que j'ai deux conditions alternatives : ou la valeur "0" en colonne R ou la valeur "RLC" en colonne V. Dans ces cas-là, les données ne sont pas extraites.
Au lieu de mettre "Formula = "=AND(" & SourceName & "RC[8]=""Maison"""
Formula = Formula & "," & SourceName & "RC[5]=""M"")"" comme dans votre exemple, j'ai donc mis ""Formula = "=OR" puis les critères.

Comme je l'ai commenté dans la procédure proposée dans ma première intervention
La variable nommée Formula doit construire la formule que l'on écrirait manuellement soit dans mon exemple

Code:

=AND([ListeCommunale.xls]db!RC[8]=""Maison"",[ListeCommunale.xls]db!RC[5]=""M"")"

Ce qui donne en langage VBA
Code:

1 2 3 SourceName = "[" & FileNameSource & "]" & SheetSource & "!" Formula = "=AND(" & SourceName & "RC[8]=""Maison""" Formula = Formula & "," & SourceName & "RC[5]=""M"")"
Pour obtenir ce code, il suffit
1) d'écrire la formule à la main et de valider par retour
2) Rester sur la cellule où l'on vient d'écrire la formule
3) Activer l'enregistreur de macros
4) Aller dans la barre des formules et valider par retour
5) Arrêter l'enregistreur des macros
6) Adapter le code généré par l'enregistreur de macros pour faire en sorte d'alimenter la variable Formula

Mea Culpa

Bonjour,
Après avoir testé la formule avec OR au lieu de AND, j'ai effectivement constaté un problème par rapport aux données filtrées.
J'avais oublié de faire un clear des données juste avant l'exportation.
Il y a donc lieu d'ajouter cette ligne juste avant la ligne qui active l'exportation.

Code:

rngExport.Worksheet.Cells.Clear ' Efface les données de la feuille d'exportation

Aperçu des lignes qui précèdent et qui suivent la ligne en question
Code:

1 2 3 4 5 6 7 ' Alimentation de la zone des critères rngCriteria(1) = "Criteria" ' Ligne 1 rngCriteria(2) = Formula ' Ligne 2 rngExport.Worksheet.Cells.Clear ' Efface les données de la feuille d'exportation ' Exportation par le filtre avancé With rngData: .AdvancedFilter xlFilterCopy, rngCriteria, rngExport: End With ' Enlève la formule de la zone des critères et ferme les fichiers Source

Bonjour,

J'ai retravaillé sur le code et comme la solution des filtres avancés me posait difficultés, je suis reparti sur la première solution, inspirée de ce post http://www.developpez.net/forums/d11...dition-resolu/.

A l'heure actuelle, voici mon code qui marche pas mal du tout, sans plus aucune erreur signalée, ni problème de syntaxe. Pour moi, c'est déjà un grand pas franchi.
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 Private Sub CommandButton1_Click() ' Définition des constantes et des variables Const FolderSource As String = "G:\CPT\Suivi des notifications d'indus\Journées\" Const FolderCible As String = "G:\CPT\Suivi des notifications d'indus\" Const FileNameCible As String = "Liste des indus créés à compter de 052013.xlsm" Const SheetSource As String = "A" Const SheetCible As String = "Total des indus non soldés" Dim wkbSource, wkbCible As Workbook, shSource, shCible As Worksheet Dim Lig As Long, nbrLig As Long, NumLig As Long Dim Col As String, Ext As String, Nom As String Nom = ThisWorkbook.Sheets(1).Range("G6").Value Ext = ".xls" Set wkbSource = Workbooks.Open(FolderSource & Nom & Ext) ' Renommer la 1ère feuille du fichier wkbSource en "A" wkbSource.Sheets(1).Name = "A" ' Changement du format de la colonne R du fichier wbkSource Columns("R:R").Select Selection.NumberFormat = "0.00" Range("R1").Select Selection.NumberFormat = "General" ' Ouverture du fichier et de la feuille cibles : Total des indus non soldés de Liste des indus créés à compter de 052013.xlsm Set wkbCible = Workbooks.Open(FolderCible & FileNameCible) Set shCible = wkbCible.Worksheets("Total des indus non soldés") Set shSource = wkbSource.Worksheets("A") NumLig = 1 With shSource nbrLig = .Range("R" & .Rows.Count).End(xlUp).row nbrLig = .Range("W" & .Rows.Count).End(xlUp).row For Lig = 2 To nbrLig If .Cells(Lig, "R").Value <> "0" Or .Cells(Lig, "V").Value <> "RLC" Then .Range("A" & Lig & ":W" & Lig).Copy NumLig = NumLig + 1 Cells(NumLig, 1).Select shCible.Paste End If Next End With End Sub
J'ai cependant encore deux difficultés :

1°) le but est de coller les données dans la première ligne vide de la feuille cible. A l'heure actuelle, la macro les colle à l'endroit où le fichier a été fermé. J'ai bidouillé, mais sans succès.

2°) il semblerait que la macro ignore mes conditions et qu'elle colle les données même s'il y a "0" en colonne R ou "RLC" en colonne V. Y a-t-il une erreur de syntaxe quelque part ?

Merci d'avance pour votre aide.

Cordialement.

18/07/2013, 15h31
benadry

Bonjour le forum,

J'ai trouvé une réponse à ma première question.

Apparemment, il suffit de remplacer

Code:

Cells(NumLig, 1).Select

par

Code:

Range("A65000").End(xlUp).Offset(1).Select

En revanche, si quelqu'un pouvait m'aider pour la seconde question ci-dessus, ce serait vraiment très gentil !

Bien cordialement.
19/07/2013, 09h26
benadry

Bonjour,

Pour info, j'ai trouvé la réponse sur un autre forum :

Au lieu de

Code:

If .Cells(Lig, "R").Value <> 0 Or .Cells(Lig, "V").Value <> "RLC" Then

Il suffit d'écrire

Code:

If .Cells(Lig, "R").Value <> 0 And .Cells(Lig, "V").Value <> "RLC" Then

Il fallait y penser !

Bonne journée.