Automatisation de manip par macros

Bonjour Yochma, le Forum

Voici une procédure qui devrait faire exactement ce que tu veux pour les quatres points mentionnés :

Option Explicit

Const ThePath As String = "C:\Documents and Settings\te\My Documents\TEST\Essai1\[Base.xls]"

Sub WeeklyReport()
Dim TheWeeks() As String
Dim WS As Worksheet
Dim x As Integer, j As Integer, i As Integer, ii As Integer
Dim Tmp1 As String, Tmp2 As String
Dim LastWeek As String
Dim LastNum As Byte


ReDim TheWeeks(Worksheets.Count)
  For Each WS In Worksheets
   TheWeeks(x) = WS.Name
   x = x + 1
  Next

   For i = LBound(TheWeeks) To UBound(TheWeeks)
      For j = LBound(TheWeeks) + ii To UBound(TheWeeks)
        If TheWeeks(i) > TheWeeks(j) Then
         Tmp1 = TheWeeks(j): Tmp2 = TheWeeks(j)
         TheWeeks(j) = TheWeeks(i): TheWeeks(j) = TheWeeks(i)
         TheWeeks(i) = Tmp1: TheWeeks(i) = Tmp2
        End If
      Next j
    ii = ii + 1
   Next i

LastWeek = TheWeeks(UBound(TheWeeks))

On Error GoTo ErrorHandler
LastNum = CByte(Right(LastWeek, Len(LastWeek) - 7))

On Error GoTo 0

Worksheets(LastWeek).Copy after:=Worksheets(Worksheets.Count)
  With Worksheets(Worksheets.Count)
    .Name = "Semaine" & LastNum + 1
      For i = 2 To 4
        .Range("B" & i).Formula = "='" & ThePath & "Sem" & LastNum + 1 & "'!$B" & i
      Next

      For i = 1 To 7
        If Weekday(Date + i) = vbMonday Then .Range("D1") = Date + i
      Next
  End With


Exit Sub
ErrorHandler:
MsgBox "Le nom de la Feuille " & LastWeek & "n'est pas au format adéquate"
End Sub


Pour la date du lundi suivant de la semaine précédente ... J'ai pas tout compris !! surtout que tu as mis dans ton code "9/23/2004" qui est Jeudi !! lol Donc le code ci-dessus trouveras le prochain Lundi ... A toi de tester et/ou de mieux t'expliquer...

Bon Après Midi
@+Thierry

Arf, petite correction...

La reconstruction Tableau en ordre croissant pour trouver la semaine la plus grande est pour un tableau en deux dimensions pas nécessaire ici, sorry !

  For i = LBound(TheWeeks) To UBound(TheWeeks)
    For j = LBound(TheWeeks) + ii To UBound(TheWeeks)
      If TheWeeks(i) > TheWeeks(j) Then
        Tmp1 = TheWeeks(j)
        TheWeeks(j) = TheWeeks(i)
        TheWeeks(i) = Tmp1
      End If
    Next j
   ii = ii + 1
  Next i

Et, of course, changer la constante "ThePath" en fonction du chemin pour Base.xls

Bon Aprèm
@+Thierry

Merci MONSIEUR Thierry!!

C'est super sympa d'avoir pris un peu de ton temps pour m'aider.


çà ne réponds pas totalment à ma demande mais je me suis mal exprimer


Merci encore

Yochma

Re Bonjour Yochma, le Forum,

"You Are Welcome" comme disent nos voisins d'outre Atlantique...

Ah et bien j'en suis bien triste alors !!! Mais tu peux toujours t'expliquer pour ce que tu demandes et qui n'est pas adapté correctement, car là on n'a pas encore le don de voyance sur XLD !!! lol

Bonne Fin d'Après Midi
@+Thierry

Mister T-----ieery!!!!

Voila je t'explique comme à ta demande car je ne peux pas t'envoyer de boule de cristal.

J'ai appilqué ta macro dans le fichier joint , mas la date ne se met pas à jour snif et les liaisons ne se font pas toutes sur la plage (b2;b4)

De plus, mon fichier est un simple exmple et les plages que je devrai lier dans mon fichier définitif seront différentes alors comment faire dans la macro pour modifier la taille de la plage, par exemple, au lieu de (b2;b4) comment faire pour avoir (b10;b30) ou encore (a1;d16)????


Voila mister T mes problèmes snif!!!

En tout cas encore merci pour t arécativité.


Yochma

Re Yochna, le Forum

Je viens de faire tourner avec ton classeur en adapatant juste "ThePath" à mon environnement, voici les résulats :

    1) J'ai bien une feuille semaine6 qui s'est créée...

    2) J'ai bien la date 23/08/2004 en Range("D1") de cette feuille "Semaine6"...(c'est bien le prochain Lundi...)

    3) Je n'ai pas de souci pour la formule dans les cellules "B2", "B3" & "B4" j'ai bien respectivement :
      ='C:\Documents and Settings\te\My Documents\TEST\Essai1\[Base.xls]Sem6'!$B2
      ='C:\Documents and Settings\te\My Documents\TEST\Essai1\[Base.xls]Sem6'!$B3
      ='C:\Documents and Settings\te\My Documents\TEST\Essai1\[Base.xls]Sem6'!$B4

Donc voilà où j'en suis...

Pour changer la plage d'écriture de la Formule il suffit de faire ceci :
For i = 2 To 4
.Range("B" & i).Formula = "='" & ThePath & "Sem" & LastNum + 1 & "'!$B" & i
Next

Ici j'écris dans B & i soit "B2", "B3" & "B4"....

Si je voulais écrire dans "A1" à "A16" je ferai ceci :
For i = 1 To 16
.Range("A" & i).Formula = "='" & ThePath & "Sem" & LastNum + 1 & "'!$B" & i
Next

Maintenant si on est sur plusieurs colonnes de "A1" à "D16" (c'est bizarre) mais on peut le faire en basculant de "Range" à "Cells" comme ceci en double boucles imbriquées :
For x = 1 To 4
  For i = 1 To 16
    .Cells(i, x).Formula = "='" & ThePath & "Sem" & LastNum + 1 & "'!$B" & i
  Next i
Next x

Voilà à peu près ce que celà donne...
Bon Courage
@+Thierry