XL 2016 recupere a partir d'un mot

Guismo33 · 9 Janvier 2019

Bonjour à tous ,

une personne du forum ma gentiment fais une VBA qui fonctionne , mais je voudrais l'améliorer
voici la VBA :

Sub Copier()
Dim source As Workbook, dest As Workbook, n%
On Error Resume Next
Set source = Workbooks("Recupe_Resultat.xlsm") 'à adapter
Set dest = Workbooks("model_prono.xlsm") 'à adapter
If Err Then MsgBox "Les 2 fichiers 'Recupe' et 'model' doivent être ouverts...": Exit Sub
On Error GoTo 0
If source.Worksheets.Count <> dest.Worksheets.Count Then MsgBox "Le nombre des feuilles de calcul n'est pas le même !", 48: Exit Sub
For n = 1 To source.Worksheets.Count
source.Worksheets(n).Range("A3862").Copy dest.Worksheets(n).Range("AX43")
Next

End Sub

Donc je récupère les même informations sur plusieurs feuilles en A3862 et les copies sur un autre classeur, pour cela c bon, mon problème c que c informations que je récupère ne sont pas forcement au même endroit sur les feuilles
je vous joint une capture d'écran.
je voudrais récupère a partir du mot "Jeu Simple (1 €)" à 2 sur 4 (3 €) de toutes les feuilles .

merci à vous

bien à vous

job75 · 9 Janvier 2019

Bonjour Guismo33,

La "gentille personne" c'était votre serviteur.

Mai là c'est vous qui n'êtes pas gentil : joignez les 2 fichiers pour qu'on puisse tester.

A+

zebanx · 9 Janvier 2019

Bonjour @job75, Guismo33, le forum

@job75
Ca y est, tu te remets aux courses de chevaux ?? (pensées aux fichiers de Guido)

Pas sûr de t'avoir présenté mes voeux : très bonne année 2019 et merci pour tout ce que tu fais et...t'apprêtes encore à faire )).
@+

job75 · 9 Janvier 2019

Bonjour zebanx,

zebanx à dit:
Pas sûr de t'avoir présenté mes voeux : très bonne année 2019 et merci pour tout ce que tu fais et...t'apprêtes encore à faire )).

Merci beaucoup quant à moi j'ai présenté mes voeux à tout le monde en début de mois.

Guismo33 · 9 Janvier 2019

job75 à dit:
Bonjour zebanx,

Merci beaucoup quant à moi j'ai présenté mes voeux à tout le monde en début de mois.

Bonjour job 75
oh , oui gloire ,beauté, joie et argent pour cette année 2019 .
oui c vous qui m'avais offert cette VBA et je me suis rendu compte que les fichiers importer n'était pas pas toujours
a la même cellule , donc en partant du même nom (puisque cela restera toujours le même) copier et coller.
je te remercie Job75 par avance .

bien à vous

Guismo33 · 9 Janvier 2019

Guismo33 à dit:
Bonjour job 75
oh , oui gloire ,beauté, joie et argent pour cette année 2019 .
oui c vous qui m'avais offert cette VBA et je me suis rendu compte que les fichiers importer n'était pas pas toujours
a la même cellule , donc en partant du même nom (puisque cela restera toujours le même) copier et coller.
je te remercie Job75 par avance .

bien à vous

Guismo33 · 9 Janvier 2019

Guismo33 à dit:
Bonjour job 75
oh , oui gloire ,beauté, joie et argent pour cette année 2019 .
oui c vous qui m'avais offert cette VBA et je me suis rendu compte que les fichiers importer n'était pas pas toujours
a la même cellule , donc en partant du même nom (puisque cela restera toujours le même) copier et coller.
je te remercie Job75 par avance .

bien à vous

job75 · 9 Janvier 2019

Difficile à comprendre car les fichiers ne correspondent pas à la macro du post #1 :

- les noms des fichiers ne sont pas corrects

- la destination AX43 ne semble pas bonne, que faut-il utiliser ?

- pourquoi joindre 2 fichiers de 2,5 Mo ?

A+

Guismo33 · 9 Janvier 2019

job75 à dit:
Difficile à comprendre car les fichiers ne correspondent pas à la macro du post #1 :

- les noms des fichiers ne sont pas corrects

- la destination AX43 ne semble pas bonne, que faut-il utiliser ?

- pourquoi joindre 2 fichiers de 2,5 Mo ?

A+

re,
oups , je me suis tromper de fichier.

job75 · 9 Janvier 2019

Bah cela ne répond pas aux questions de mon post #8 !

Guismo33 · 10 Janvier 2019

job75 à dit:
Bah cela ne répond pas aux questions de mon post #8 !

Bonjour job,
dans le fichier "exemple_resultat" j'ai 30 feuilles avec des infos, je voudrais copier les infos entre le mot "Jeu Simple" et "2 sur 4" sur les colonne A:C
pour les coller dans le fichier "exemple_prono" en AY43 .

job75 · 10 Janvier 2019

Bonjour Guismo33,

Guismo33 à dit:
pour les coller dans le fichier "exemple_prono" en AY43 .

AY43 ne me paraît pas l'endroit idéal mais bon :

Code:

Sub Copier()
Dim source As Workbook, dest As Workbook, n%, lig1 As Variant, lig2 As Variant
On Error Resume Next
Set source = Workbooks("exemple_Resultat.xlsm") 'à adapter
Set dest = Workbooks("exemple_prono.xlsm") 'à adapter
If Err Then MsgBox "Les 2 fichiers 'exemple_Resultat' et 'exemple_prono' doivent être ouverts...": Exit Sub
On Error GoTo 0
If source.Worksheets.Count <> dest.Worksheets.Count Then MsgBox "Le nombre des feuilles de calcul n'est pas le même !", 48: Exit Sub
For n = 1 To source.Worksheets.Count
    With source.Worksheets(n)
        lig1 = Application.Match("Jeu Simple (1 €)", .Columns("A"), 0)
        lig2 = Application.Match("2 sur 4 (3 €)", .Columns("A"), 0)
        dest.Worksheets(n).Range("AY43:BB" & dest.Worksheets(n).Rows.Count).Delete xlUp 'RAZ
        If IsNumeric(lig1) And IsNumeric(lig2) Then _
            .Range(.Cells(lig1, 1), .Cells(lig2, 4)).Copy dest.Worksheets(n).Range("AY43")
    End With
Next
End Sub

A+

Guismo33 · 10 Janvier 2019

job75 à dit:

Bonjour Guismo33,

AY43 ne me paraît pas l'endroit idéal mais bon :

Code:

Sub Copier()
Dim source As Workbook, dest As Workbook, n%, lig1 As Variant, lig2 As Variant
On Error Resume Next
Set source = Workbooks("exemple_Resultat.xlsm") 'à adapter
Set dest = Workbooks("exemple_prono.xlsm") 'à adapter
If Err Then MsgBox "Les 2 fichiers 'exemple_Resultat' et 'exemple_prono' doivent être ouverts...": Exit Sub
On Error GoTo 0
If source.Worksheets.Count <> dest.Worksheets.Count Then MsgBox "Le nombre des feuilles de calcul n'est pas le même !", 48: Exit Sub
For n = 1 To source.Worksheets.Count
    With source.Worksheets(n)
        lig1 = Application.Match("Jeu Simple (1 €)", .Columns("A"), 0)
        lig2 = Application.Match("2 sur 4 (3 €)", .Columns("A"), 0)
        dest.Worksheets(n).Range("AY43:BB" & dest.Worksheets(n).Rows.Count).Delete xlUp 'RAZ
        If IsNumeric(lig1) And IsNumeric(lig2) Then _
            .Range(.Cells(lig1, 1), .Cells(lig2, 4)).Copy dest.Worksheets(n).Range("AY43")
    End With
Next
End Sub

A+

Re, Job

je te remercie , cela fonctionne correctement, quand ont ne connais pas grand chose c difficile par message de se faire comprendre.
je te souhaite bonne journée .

bien à vous

XL 2016 recupere a partir d'un mot

Guismo33

XLDnaute Occasionnel

Pièces jointes

job75

XLDnaute Barbatruc

zebanx

XLDnaute Accro

job75

XLDnaute Barbatruc

Guismo33

XLDnaute Occasionnel

Pièces jointes

Guismo33

XLDnaute Occasionnel

Guismo33

XLDnaute Occasionnel

Pièces jointes

job75

XLDnaute Barbatruc

Guismo33

XLDnaute Occasionnel

Pièces jointes

job75

XLDnaute Barbatruc

Guismo33

XLDnaute Occasionnel

Pièces jointes

job75

XLDnaute Barbatruc

Guismo33

XLDnaute Occasionnel

Discussions similaires