Souci de déroulement de ma macro

[PHILIP]

Bonjour à tous

J'ai 2 souci avec ma macro qui fonctionne mais ne respecte pas l'ordre des données
1 je demande à la macro d'ouvrir un classeur "stockjour", d'actualiser les données, puis d'ouvrir un autre classeur, "bestand_2009" afin de transferer les données dans ce dernier. Malheureusement elle transmet les donnés avant l'actualisation que peut-on faire afin de transferer les données apres l'actualisation ?
2 La macro prend la date du jour aujourdhui() du classeur "stockjour", qui est sous la forme 11/11/2009 et cherche la même date dans le classeur "Bestand_2009" pour y coller les données actualisées du stockjour le souci c'est que dans ce classeur "Bestand_2009" les dates sont du type mercredi 11 novembre 2009
donc rien ne se passe sauf si je modifie les dates au même format que "stockjour" je voudrai cependant conserver le format de la date de bestand_2009 Y'a t'il une solution ? je joins la macro

Sub etatdestock()
Workbooks.Open "C:\Documents and Settings\PC42\Bureau\suivi stock\stockjour.xls"
ActiveWorkbook.RefreshAll
Workbooks.Open "T:\suivi_stock_2009\Bestand_2009.xls"
Dim wb1 As Workbook, wb2 As Workbook
Set wb1 = Workbooks("stockjour.xls")
Set wb2 = Workbooks("Bestand_2009.xls")
Dim plage As Range, c As Range
Dim LastLig As Long
Dim i As Byte
LastLig = wb2.Sheets("novembre").Range("A65536").End(xlUp).Row
Set plage = wb2.Sheets("novembre").Range("A7:A" & LastLig)
Set c = plage.Find(wb1.Sheets("Tagesbestand").Range("A1").Value, LookIn:=xlFormulas, lookat:=xlWhole)
If Not c Is Nothing Then
    For i = 1 To 5
        c.Offset(0, i).Value = wb1.Sheets("Tagesbestand").Range("B" & i + 4).Value
    Next i
End If
Set c = Nothing
Set plage = Nothing
End Sub

Merci pour votre aide

 

[Guest]

Re : Souci de déroulement de ma macro

Bonjour

Alors question RefreshAll, sans doute faut-il attendre la fin du recalcul des données alors test ceci:

.....
ActiveWorkbook.RefreshAll
'boucle pour attendre la fin du recalcul
Do While  Application.CalculationState <> xlDone
Loop
......

Pour les Dates, c'est vrai que c'est toujours compliqué à un moment donné au un autre avec Find. aussi j'emploie souvent la fonction ci-dessous, qui utilise l'équivalent de la fonction de feuille de calcul Equiv.

Function EquivDate(dte As Date, Plage As Range) As Long
   Dim idx
   idx = Application.Match(CLng(dte), Plage, 0)
   If Not IsError(idx) Then EquivDate = idx
End Function

A+

 

[PHILIP]

Re : Souci de déroulement de ma macro

Bonjour Hasco

Merci pour ton aide car je suis encore un peu novice Peux tu me dire ou je place la function dans la macro?

 

[Guest]

Re : Souci de déroulement de ma macro

bonjour,

Voici un module avec la fonction et ta macro réécrite.

Option Explicit
 
Function EquivDate(dte As Date, plage As Range) As Long
   Dim idx
   idx = Application.Match(CLng(dte), plage, 0)
   If Not IsError(idx) Then EquivDate = idx
End Function
 
Sub etatdestock()
    Dim wb1 As Workbook, wb2 As Workbook
    Set wb1 = Workbooks("stockjour.xls")
    Set wb2 = Workbooks("Bestand_2009.xls")
    Dim plage As Range, c As Range
    Dim LastLig As Long
    Dim idxDate As Variant
    Dim i As Byte
    Workbooks.Open "C:\Documents and Settings\PC42\Bureau\suivi stock\stockjour.xls"
    ActiveWorkbook.RefreshAll
[COLOR=red]  Do While  Application.CalculationState <> xlDone[/COLOR]
[COLOR=red]  Loop[/COLOR]
    Workbooks.Open "T:\suivi_stock_2009\Bestand_2009.xls"
    LastLig = wb2.Sheets("novembre").Range("A65536").End(xlUp).Row
    Set plage = wb2.Sheets("novembre").Range("A7:A" & LastLig)
   [COLOR=red]idxDate = EquivDate(wb1.Sheets("Tagesbestand").Range("A1").Value, plage)[/COLOR]
[COLOR=red]  If idxDate > 0 Then Set c = plage.Cells(idxDate)[/COLOR]
    If Not c Is Nothing Then
        For i = 1 To 5
            c.Offset(0, i).Value = wb1.Sheets("Tagesbestand").Range("B" & i + 4).Value
        Next i
    End If
    Set c = Nothing
    Set plage = Nothing
End Sub

Bien sûr, à part la fonction EquivDate, je n'ai pu tester.

A+