Discussion :

[corsica13]

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 :

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

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.

[casefayere]

Bonjour,

essaies ce code et adaptes le

Code :

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

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

[Invité]

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
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

[corsica13]

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

Mais je ne suis vraiment pas expert la-dedans 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 :

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
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"

[nibledispo]

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.

[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.

[corsica13]

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
J'ai fait ceci :

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
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