erreur ecriture

[laurent999]

Bonjour à toutes et tous,

J'ai écrit une macro qui me semble correcte, cependant cela ne fonctionne pas et je n'arrive pas à comprendre.

Je vous ai joint un dossier comprenant un Classeur1.xlsm
et un dossier comprenant deux Classeur
l'un david.xlsx
et l"autre laurent.xlsx

Sur la feuille 1 du classeur1
il y a une date
en colonne A il y a les noms correspondant aux classeur david et laurent.

en face de chaque nom en B,C,D se trouve un numéro, que l'on considérera ici comme infos

il faudrait qu'en appuyant sur le bouton, cela ouvre successivement le classeur david puis laurent et qu'en face de la date situé sur une feuille de ces classeurs, se trouve les infos.

Sur le bouton j'ai déjà affecté une macro mais elle ne fonctionne pas.

Si quelqu'un peu y apporter une correction et explications.

Merci d'avance

Laurent.

 

[kjin]

Re : erreur ecriture

Bonsoir,
J'ai fait avec les moyens du bord, v2007 oblige (David quand est ce que tu nous remets les versions dans le profil 😀)
Testé avec V2000 donc

Sub Macro1()
Dim Vsearch As Date, plg As Range
Dim fSource As String, rep As String, fichier As String
Dim fCible As String, c As Range, i As Byte, T(2) As Variant
Dim ws As Worksheet, d As Range

Vsearch = Sheets("feuil1").Cells(15, 3)
Set plg = ActiveSheet.Range("A18:A" & Range("A50000").End(xlUp).Row)
fSource = ActiveWorkbook.Name
rep = ActiveWorkbook.Path & "\E\"
fichier = Dir(rep & "*.xlsx")

Application.ScreenUpdating = False

Do While fichier <> ""
    Workbooks.Open rep & fichier
    fCible = Split(ActiveWorkbook.Name, ".")(0)
    Set c = plg.Find(fCible)
        If Not c Is Nothing Then
            For i = 0 To 2
                T(i) = c.Offset(0, i + 1)
            Next
        End If
    For Each ws In ActiveWorkbook.Sheets
        Set d = ws.Range("A1:A10000").Find(Vsearch)
        If Not d Is Nothing Then Range(Cells(d.Row, 2), Cells(d.Row, 4)) = T()
    Next
    ActiveWorkbook.Close True
    fichier = Dir
Loop

Application.ScreenUpdating = True

End Sub

A+
kjin

 

[laurent999]

Re : erreur ecriture

Merci Kjin

Cela fonctionne, cependant comme je ne suis pas spécialiste en macro, et, que j'aimerais m'améliorer.
si tu pouvais m'expliquer ce qui se passe sur se passage:
fCible = Split(ActiveWorkbook.Name, ".")(0)
Set c = plg.Find(fCible)
If Not c Is Nothing Then
For i = 0 To 2
T(i) = c.Offset(0, i + 1)
Next
End If
For Each ws In ActiveWorkbook.Sheets
Set d = ws.Range("A1:A10000").Find(Vsearch)
If Not d Is Nothing Then Range(Cells(d.Row, 2), Cells(d.Row, 4)) = T()

merci.

Laurent.

 

[kjin]

Re : erreur ecriture

Bonsoir,

'renvoie la première dimension d'un tableau créé à partir
'du nom du fichier et de son extension
fCible = Split(ActiveWorkbook.Name, ".")(0)
'on associe la variable c à la cellule trouvée contenant fcible
Set c = plg.Find(fCible)
'si c existe
If Not c Is Nothing Then
'on ajoute les 3 valeurs adjacente dans un tableau T
For i = 0 To 2
T(i) = c.Offset(0, i + 1)
Next
End If
'on boucle sur chaque feuille du classeur actif(est ce bien utile ?)
For Each ws In ActiveWorkbook.Sheets
'on associe la variable c à la cellule trouvée contenant Vsearch (la date)
Set d = ws.Range("A1:A10000").Find(Vsearch)
'si d existe, on place dans les 3 cellules adjacentes les valeurs du tableau T
If Not d Is Nothing Then Range(Cells(d.Row, 2), Cells(d.Row, 4)) = T()

A+
kjin