XL 2016 recupere a partir d'un mot

Guismo33

XLDnaute Occasionnel
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("A38:D62").Copy dest.Worksheets(n).Range("AX43")
Next

End Sub

Donc je récupère les même informations sur plusieurs feuilles en A38:D62 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
 

Fichiers joints

job75

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

XLDnaute Impliqué
Bonjour @job75, Guismo33, le forum

@job75
Ca y est, tu te remets aux courses de chevaux ?? :D:D (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 :)):cool:).
@+
 

job75

XLDnaute Barbatruc
Bonjour zebanx,
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 :)):cool:).
Merci beaucoup quant à moi j'ai présenté mes voeux à tout le monde en début de mois.
 

Guismo33

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

Fichiers joints

Guismo33

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

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

Fichiers joints

job75

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

XLDnaute Occasionnel
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 .
 

Fichiers joints

job75

XLDnaute Barbatruc
Bonjour Guismo33,
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

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

Discussions similaires


Haut Bas