calendrier

[wrndid]

bonjour
je voudrais créé un bp dans chaque feuille du mois taper le numeros de semaine et le copier dans la feuille semaine

 

[wrndid]

Re : calendrier

bonjour
voici un exemple
feuille avril semaine 4 je copie de C6 a AG12 dans la feuille semaine
ou semaine 17 je copie C27 a >AG3 de la feuille de mai
merci

 

[Efgé]

Re : calendrier

Bonjour wrndid,
Comme j'étais surpris par l'absence de réponse à ta question,j'ai regardé ton fichier.
Dans l'état actuel des choses, je ne vois pas comment faire.
Les "dates" sont toutes au format texte et au format "jj" par formule donc difficile d'en faire quelque chose.
Les numéros de semaine ne sont pas à la norme ISO donc difficile d'extraire les mêmes semaines que toi.
Si on modifie tout ça, il y a peut être une solution de ce type:

Sub Extract_Sem()
Dim DateCherche, i&, J&, K&, L&
Dim TabReport(1 To 7, 1 To 32)
K = 0
DateCherche = InputBox("Veuillez saisir le numéro de semaine")
If DateCherche = 0 Or DateCherche = "" Then Exit Sub
If DateCherche < 1 Or DateCherche > 55 Then
    MsgBox "Merci de saisir un numéro de semaine valide"
    Exit Sub
End If
With ActiveSheet
    For i = 3 To .Cells(Rows.Count, 2).End(xlUp).Row
        If Format(.Cells(i, 2), "WW", vbFirstFourDays) = DateCherche Then
        K = K + 1
            For J = 1 To 32
                TabReport(K, J) = .Cells(i, J)
            Next J
        End If
    Next i
End With
If K = 0 Then
    MsgBox "Cette semaine n'est pas présente sur cette feuille"
Else
    Sheets("semaine").Cells(6, 2).Resize(7, 32) = TabReport
    MsgBox "Semaine copiée"
End If
End Sub

Bon courage pour la suite.
Cordialement

 

[Efgé]

Re : calendrier

Re
En fait, c'est faisable...

Sub Extract_Sem()
Dim DateCherche, i&, J&, K&, L&
Dim TabReport(1 To 7, 1 To 31)
K = 0
DateCherche = InputBox("Veuillez saisir le numéro de semaine")
If DateCherche = 0 Or DateCherche = "" Then Exit Sub
If DateCherche < 1 Or DateCherche > 55 Then
    MsgBox "Merci de saisir un numéro de semaine valide"
    Exit Sub
End If
With ActiveSheet
    For i = 3 To .Cells(Rows.Count, 2).End(xlUp).Row
        If Format(DateSerial(Range("noan"), .Cells(2, 1), .Cells(i, 3)), "WW", vbMonday, vbFirstFourDays) = DateCherche Then
        K = K + 1
            For J = 1 To 31
                TabReport(K, J) = .Cells(i, J + 2)
            Next J
        End If
    Next i
End With
If K = 0 Then
    MsgBox "Cette semaine n'est pas présente sur cette feuille"
Else
    Sheets("semaine").Cells(6, 2).Resize(7, 31) = TabReport
    MsgBox "Semaine copiée"
End If
End Sub

Cordialement

 

[wrndid]

Re : calendrier

bonjour
ca marche apres semaine 11 mai pas 9 et 10
merci

 

[Efgé]

Re : calendrier

Re
Chez moi il n'y a pas de problème. Pour les semaines de 1 à 9 il faut saisir 1 ou 2 ou ... pas 01, 02 ... et être sur la bonne feuille évidemment puisque tu demandai une macro pour mettre un bouton sur chaque feuille.
Cordialement

 

[wrndid]

Re : calendrier

bonjour
code erreur 9
ca bloque sur cette ligne

TabReport(K, J) = .Cells(i, J + 2)

merci

 

[Efgé]

Re : calendrier

Re
Sous la forme que je t'ai donnée, je ne rencontre aucun problème (Excel 2003)
Peux tu mettre un fichier avec juste le code que tu utilise et qui ne fonctionne pas chez toi ?
Cordialement

 

[Efgé]

Re : calendrier

Re
Après tests, je pense que tu as voulu agrandir la plage copiée en changeant la ligne " For J = 1 To 31" Sans changer "Dim TabReport(1 To 7, 1 To 31)" .
Je te propose une autre version plus façile à adapter (bien que, en regardant les codes de ton fichier, tu devrais pouvoir modifier ma proposition 🙄 ).
Cette nouvelle version colle les semaines sur la bonne ligne (si la semaine présente sur la feuille va du Mercredi au Dimanche, par exemple, le dimanche est sur la dernière ligne du tableau) pour respecter ta coloration des W.E.
Après je ne vois que faire de plus.

Sub Extract_Sem()
Dim DateCherche, i&, J&, K&, L&, NbrCol&, NumJour%, FrstCol&
Dim Ddate As Date, TabReport()
K = 0: NumJour = 0
NbrCol = 31 'Nombre de colonnes à copier
ReDim TabReport(1 To 7, 1 To NbrCol)
DateCherche = InputBox("Veuillez saisir le numéro de semaine")
If DateCherche = 0 Or DateCherche = "" Then Exit Sub
If DateCherche < 1 Or DateCherche > 53 Or Not IsNumeric(DateCherche) Then
    MsgBox "Merci de saisir un numéro de semaine valide"
    Exit Sub
End If
With ActiveSheet
    For i = 3 To .Cells(Rows.Count, 2).End(xlUp).Row
        Ddate = DateSerial(Range("noan"), .Cells(2, 1), .Cells(i, 3))
        If Format(Ddate, "WW", vbMonday, vbFirstFourDays) = DateCherche Then
        If NumJour = 0 Then NumJour = Weekday(Ddate, vbMonday)
        K = K + 1
            For J = 1 To NbrCol
                TabReport(K, J) = .Cells(i, J + 2)
            Next J
        End If
    Next i
End With
With Sheets("semaine")
    .Range(.Cells(6, 2), .Cells(12, NbrCol)).ClearContents
    If K = 0 Then
        MsgBox "Cette semaine n'est pas présente sur cette feuille"
    Else
        .Cells(NumJour + 5, 2).Resize(K, NbrCol) = TabReport
        MsgBox "Semaine copiée"
    End If
    '.Activate
End With
End Sub

Cordialement

 

[wrndid]

Re : calendrier

bonjour
le probleme est toujours la
Indice en dehors de la plage (erreur 9)
TabReport(K, J) = .Cells(i, J + 2)
si je tape semaine 10 les valeurs de k=8 et j=1
merci

 

[Efgé]

Re : calendrier

Bonjour wrndid, le fil, le forum
Je ne comprend vraiment pas comment on peux trouver 8 jours dans une semaine 🙄.
Je met un exemple avec le strict minimum (sans le USF, sans les 11 modules...)
J'ai mis un bouton sur la feuille Mars. En l'utilisant et en choisissant la semaine 10, par exemple, on trouve bien 7 jours copiés sur la feuille semaine.
Cordialement

 

[wrndid]

Re : calendrier

bonjour ca marche sur le votre pas sur me mien
merci

 

[Efgé]

Re : calendrier

Bonjour wrndid, le fil, le forum
J'ai trouvé (enfin, je pense).
Il y a des dates dans la colonne B sous la liste des dates du mois (en cellule B50 de la feuille Mars par exemple...)
Pour remédier à ce piège il faut utiliser
For i = 3 To 33
Au lieu de
For i = 3 To .Cells(Rows.Count, 2).End(xlUp).Row

Cordialement

 

[wrndid]

Re : calendrier

nerci ca marche

 

[wrndid]

Re : calendrier

bonjour
peut on recuperer les jour de la semaine qui manque
exemple mars S9 manque lundi
et s 13 manque de vendredi a Dimanche
merci