Bonjour a tous,
bonne année, santé a tous .
voici ma vba que l'on ma gentiment fait et je voudrais l'améliorer
je recupere des informations sur le web
je recupere des informations a partir des feuilles , a partir du cellule qui comporte un nom
et je recopie dans un autre classeur a un autre endrois .
Sub Copier()
Dim source As Workbook, dest As Workbook, n%
Dim Ref As String
On Error Resume Next
Set source = Workbooks("Recupe_Prono.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
Range("a1").Select ' je selectionne la celleule A1
Cells.Find(What:="Synthèse des chevaux les plus cités", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate ' JE RECHERCHE LE MOTS
ad = ActiveCell.Address 4 OBETENIR L'ADRESSE
l = ActiveCell.Row ' RECUPERE LE NUMERO DE LIGNE
source.Worksheets(n).Range(ad & ":i" & l).Copy dest.Worksheets(n).Range("C43") ' JE COPIE
Next
End Sub
Ceci ne veux pas fonctionner, pourriez vous ameliorer ou me dire la ou cela ne va pas svp.
merci
bien à vous
bonne année, santé a tous .
voici ma vba que l'on ma gentiment fait et je voudrais l'améliorer
je recupere des informations sur le web
je recupere des informations a partir des feuilles , a partir du cellule qui comporte un nom
et je recopie dans un autre classeur a un autre endrois .
Sub Copier()
Dim source As Workbook, dest As Workbook, n%
Dim Ref As String
On Error Resume Next
Set source = Workbooks("Recupe_Prono.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
Range("a1").Select ' je selectionne la celleule A1
Cells.Find(What:="Synthèse des chevaux les plus cités", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate ' JE RECHERCHE LE MOTS
ad = ActiveCell.Address 4 OBETENIR L'ADRESSE
l = ActiveCell.Row ' RECUPERE LE NUMERO DE LIGNE
source.Worksheets(n).Range(ad & ":i" & l).Copy dest.Worksheets(n).Range("C43") ' JE COPIE
Next
End Sub
Ceci ne veux pas fonctionner, pourriez vous ameliorer ou me dire la ou cela ne va pas svp.
merci
bien à vous