Copier à partir d'une expression trouvée

Version imprimable

15/07/2013, 09h00
corsica13

Copier à partir d'une expression trouvée

Bonjour,

Je cherche s'il vous plait comment faire pour copier tout une colonne d'un fichier à partir d'un mot trouvé...

Je m'explique j'ai un titre de colonne qui est "BONJOUR" et deux cases en dessous les données qui m'intéressent...

Je voudrais donc dire à ma Macro, dès que tu trouves le mot "Bonjour" dans un des fichiers concernés, tu sautes deux cases et tu me recopie tout ce qu'il y a...

Actuellement j'ai ça :

Code:

Workbooks(fichier).Sheets("FCR - Main").Range("F14:G54").Copy

mais j'aimerais au lieu de "F14" dire "A partir de deux cases en dessous le mot Bonjour"

J'ai pas mal cherché sur le net mais en vain...j'ai cru trouver une approche avec Cells.find mais je n'ai pas réussi à l'utiliser

Voilà merci d'avance
Cordialement.

Bonjour,

essaies ce code et adaptes le

Code:

1
2
3
Dim Ch As Range
Set Ch = Rows(1).Find("Bonjour")
Sheets("Feuil1").Range(Ch(3, 1).Address, "G54").Copy Range("A1") 'à mettre à jour pour tes besoins

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Option Explicit
 
Sub RechercheMotif()
 
    Dim C As Range
 
    With Workbooks(fichier).Worksheets("FCR - Main")
 
        Set C = .Cells.Find("BONJOUR", , , xlWhole)
        If C Is Nothing Then Exit Sub
 
        .Range(.Cells(C.Offset(2, 0).Row, C.Column), .[G54]).Copy
 
    End With
 
End Sub

Merci à tous les deux pour vos réponses...

Mais je ne suis vraiment pas expert la-dedans :cry: et donc j'ai essayé de placer votre code à l'intèrieur du mien mais je n'ai pas réussi

Voilà ce que j'ai actuellement et qui fonctionne :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 Sub Month() ' /////////////////////////Ouverture du 1er fichier ://///////////////////////////////////////////// Workbooks.Open "C:\Rep\Function\" & Sheets(1).Range("A2").Text & "\" & Sheets(1).Range("A1").Text & "\sec\Function- 0001X - " & Sheets(1).Range("A1").Text & " " & Sheets(1).Range("A2").Text & ".xls" ' Copie des données : fichier = ActiveWorkbook.Name Workbooks(fichier).Sheets("FCR - Main").Range("F14:G54").Copy Workbooks("Test.xls").Activate Workbooks("Test.xls").Sheets("MONTH").Range("C7").Select Workbooks("Test.xls").Sheets("MONTH").Paste ' Fermeture du 1er fichier : Workbooks(fichier).Close ' /////////////////////////Ouverture du 2nd fichier ://///////////////////////////////////////////// ... ... ...
Donc pour votre code vcottineau je ne sais pas où placer le with ... j'ai essayé à la place de cette ligne Workbooks(fichier).Sheets("FCR - Main").Range("F14:G54").Copy mais ça n'a pas fonctionné :(

et casefayere j'ai tenté le votre également mais je me retrouve avec une erreur "Variable Objet ou variable de bloc with non définie"

15/07/2013, 10h59
nibledispo

copier à partir d'une expression

Bonjour,

je crois comprendre, à la lecture de la question, que Corsica13 souhaite recopier uniquement le contenu de la colonne intitulé "bonjour".

de plus:"un des fichiers concernés" semble indiquer une recherche dans plusieurs fichiers

ce n'est pas ce que font les codes proposés me semble-t-il mais je ne sais pas les adapter.

Comment remplacer [G54] par ladite colonne jusqu'à la dernière ligne qui n'est pas nécessairement 54 ?

Cordialement.
15/07/2013, 11h16
Invité

Il manquait un "." dans mon code. J'ai modifié le code dans mon post d'origine.
Essaie à nouveau ça devrait être bon. Sinon donne l'erreur que tu obtiens.

Je n'ai pas d'erreur lorsque je rentre votre code mais j'ai simplement le fichier "0001X - blabla" qui s'ouvre et les données ne sont plus copiées :?

Mais je pense que je ne sais pas bien placer votre code :oops:
J'ai fait ceci :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 Sub Month() Dim C As Range ' /////////////////////////Ouverture du 1er fichier ://///////////////////////////////////////////// Workbooks.Open "C:\Rep\Function\" & Sheets(1).Range("A2").Text & "\" & Sheets(1).Range("A1").Text & "\sec\Function- 0001X - " & Sheets(1).Range("A1").Text & " " & Sheets(1).Range("A2").Text & ".xls" ' Copie des données : fichier = ActiveWorkbook.Name With Workbooks(fichier).Worksheets("FCR - Main") Set C = .Cells.Find("Bonjour", , , xlWhole) If C Is Nothing Then Exit Sub .Range(.Cells(C.Offset(2, 0).Row, C.Column), .[G54]).Copy Workbooks("Test.xls").Activate Workbooks("Test.xls").Sheets("MONTH").Range("C7").Select Workbooks("Test.xls").Sheets("MONTH").Paste ' Fermeture du 1er fichier : Workbooks(fichier).Close End with
En gros j'ai l'impression que ça ne va pas jusqu'à Workbooks(fichier).close vu que le fichier ne se ferme pas et surtout ça ne copie pas les valeurs, c'est ça le plus inquiétant:cry:

Et comme ça?

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Workbooks.Open "C:\Rep\Function\" & Sheets(1).Range("A2").Text & "\" & Sheets(1).Range("A1").Text & "\sec\Function- 0001X - " & Sheets(1).Range("A1").Text & " " & Sheets(1).Range("A2").Text & ".xls"
 
' Copie des données :
fichier = ActiveWorkbook.Name
 
With Workbooks(fichier).Worksheets("FCR - Main")
 
    Set c = .Cells.Find("Bonjour", , , xlWhole)
    If c Is Nothing Then MsgBox ("La chaine 'Bonjour' n'a pas été trouvée !")
 
    .Range(.Cells(c.Offset(2, 0).Row, c.Column), .[G54]).Copy Workbooks("Test.xls").Sheets("MONTH").Range("C7")
End With
 
' Fermeture du 1er fichier :
Workbooks(fichier).Close

La chaine 'Bonjour' est bien présente sur ta feuille 'FCR - Main'?

15/07/2013, 14h47
corsica13

:) Ahhhhh merci beaucoup ça fonctionne bien ! :ccool:

Au début ca ne passait pas avec "BONJOUR" car il y avait plusieurs colonnes nommées "Bonjour" mais j'ai mis autre chose et j'ai changé le c.Offset(2, 0).Row en c.Offset(3, 0).Row et tout fonctionne 8-)

Franchement c'est bien gentil de ta part de m'avoir aidé et merci aux autres également ! :)

Super-forum et super-Personnes :)

Edit : Par contre, et ce sera ma dernière question : si je veux remplacer

Code:

Workbooks.Open "C:\Rep\Function\"

par "..\Rep\Function" car je ne sais pas dans quel lettre la personne utilisant mon fichier va être...quelle méthode me conseillez-vous ?

Ta demande est étrange ou alors je ne comprends pas bien ton problème. En tout cas tu peux utiliser le code suivant pour savoir quel lecteur utiliser:

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
Option Explicit
 
Sub CheminFichier()
 
    Dim oFSO As Object, drv As Object
    Dim strChemin As String
 
    ' Dossier recherché
    strChemin = "\Rep\Function\"
 
    'Instanciation du FSO
    Set oFSO = CreateObject("Scripting.FileSystemObject")
 
    ' Recherche du lecteur
    For Each drv In oFSO.drives
        If oFSO.FolderExists(drv & strChemin) Then
            strChemin = drv & strChemin
            Exit For
        End If
    Next drv
 
    'Affichage du chemin
    Debug.Print (strChemin)
 
End Sub

J'utilise le 'FileSystemObject' de la librairie 'Microsoft Scripting Runtime'.
Pour plus d'information: http://warin.developpez.com/access/fichiers/

15/07/2013, 15h15
corsica13
Ah je crois avoir trouvé une solution en cherchant sur le net :

J'ai mis ça :
Code:

1 2 chemin = ThisWorkbook.Path Workbooks.Open Filename:=chemin & "\" & Sheets(1).Range("A2")...
Et apparemment ça a l'air de marcher lorsque je place le .xls dans C:\Rep\Function ça me trouve automatique le chemin :)

En tout cas merci encore pour ta réactivité c'est vraiment agréable :D