Transfert de cellules d'une feuille à l'autre

Bonjour

Je voulais transférer les cellules du mois en cours de la feuiller annuelle à la feuille mensuelle. J'ai toujours un décalage d'un jour.

Merci d'avance

Bonjour,

Si vous parlez du décalage dans votre code entre la valeur de la variable "colonne" et les numéros indiqués en ligne 1 de votre feuille annuel, il n'y a rien d'annormal :

Votre appel avec Goto renvoie vers les numéros de colonne "absolus" définis dans Excel, or la colonne numéro 1 pour Excel est la A pas la B.

Pour corriger votre code en conséquence remplacez

colonne = Day(Date) + [début].Column - 1

Par

colonne = Day(Date) + [début].Column

J'ai corrigé, c'est la même chose

Alors détaillez votre problème car de toute évidence personne ne le comprend. Quel résultat attendu, pourquoi/comment... votre fichier a des numéros qui ne correspondent à rien de compréhensible, si vous ne prenez pas le temps d'expliquer comment voulez-vous etre compris ?

Voici les deux lignes la ligne juste dans la feuille mensuelle et le résultat dans la feuille mensuelle d'écalée et il manque la dernière case.

Merci d'avance

Merci pour les précisions, qui étaient plus que nécessaires. Vous n'évoquiez nulle part la mise en forme. Ci-après votre code mis à jour :

Sub Vers_Aujourdhui()
     If Year(Date) = [Année] Then 'si l'année est la bonne
         Ligne = (Month(Date) * 4) + [début].Row - 2 'calcul du numéro de ligne
         colonne = Day(Date) + [début].Column - 1 'calcul de la colonne
         Application.Goto sh_Planning.Cells(Ligne, colonne) 'on se place à la bonne cellule

         Dim rngIni As Range
         Set rngIni = Range("B" & Ligne - 1).Resize(3, 31)
         rngIni.Copy 'on copie la ligne (31 jours) en A5 de la feuille Mensuel

         With Sheets("Mensuel").Range("A5").Resize(3, 31)
            .PasteSpecial xlPasteColumnWidths
            .PasteSpecial xlPasteAll, , False, False
            .FormatConditions.Delete
            For i = 1 To .Count
                .Item(i).Interior.ColorIndex = rngIni.Item(i).DisplayFormat.Interior.ColorIndex
            Next i
         End With

         Sheets("Mensuel").Range("A3") = UCase(Format(Date, "mmmm")) 'on inscrit le mois en A2
     Else
         Application.Goto [Année] 'sinon on se place sur l'année pour pouvoir la changer..?
     End If

     Application.CutCopyMode = False
     Worksheets("Mensuel").Activate
     ActiveWindow.DisplayGridlines = False
End Sub

Merci mais ça me plante tout le programme

Ce sont vos appels sur l'activation des feuilles qui font planter excel alors, je les avais désactivés pour tester car ils me faisaient également planter. Évitez ce genre d'appels, ils sont "dangereux" pour la stabilité du programme comme vous pouvez le constater. A vrai dire je ne comprends pas que vous ayez besoin d'activer cette macro a chaque fois que vous visitez cette feuille, considérez plutôt un appel via un bouton.

Si cependant vous tenez absolument à garder ce fonctionnement étrange, alors supprimez les deux dernières lignes du sub que je vous ai envoyé, je pense que ce sont elles qui vous font planter.

     ' Worksheets("Mensuel").Activate
     ' ActiveWindow.DisplayGridlines = False

Cependant elles sont nécessaires pour désactiver l'affichage de la grille sur la feuille "mensuel", si vous voulez obtenir un résultat visuel identique à celui de la feuille initiale. Après normalement il suffit de le désactiver une fois, donc si vous le faites manuellement il ne devrait pas y avoir de problèmes.

Vous pourriez me faire la modification directement dans mon fichier. Merci d'avance

Je PEUX VOUS DÉDOMMAGER

Bonjour

Est-ce que quelqu'un pourrait me dépanner. Je m'en sors pas du tout.

$

Merci d'avance

Salut Michel,
Salut Saboh,

À ma façon..

Sub Vers_Aujourdhui()
'
Dim sWkA As Worksheet, sWkM As Worksheet, dDate As Date, iRow%, iDay%, iWidth%
'
Set sWkA = Worksheets("Annuel")
Set sWkM = Worksheets("Mensuel")
'
Application.EnableEvents = False
Application.ScreenUpdating = False
'
If Year(Date) = [Année] Then 'si l'année est la bonne
    iRow = (Month(Date) * 4) 'calcul du numéro de ligne
    dDate = DateSerial(Year(Date), Month(Date), 1)
    iWidth = DateDiff("d", dDate, DateAdd("m", 1, dDate))
    sWkA.Range("B" & iRow).Resize(3, iWidth).Copy Destination:=sWkM.[B5]
    '
    sWkM.Cells.Interior.Color = RGB(255, 255, 255)
    sWkM.[B5].Resize(3, iWidth).FormatConditions.Delete
    sWkM.[B5].Resize(1, iWidth).ColumnWidth = sWkA.Range("B" & iRow).ColumnWidth
    For x = 1 To iWidth
        iDay = Weekday(DateSerial(Year(Date), Month(Date), x), vbMonday)
        If iDay > 5 Then sWkM.Range("A6").Offset(0, x).Interior.Color = IIf(iDay = 6, RGB(255, 255, 0), RGB(0, 175, 240))
    Next
    sWkM.[A3] = sWkA.Range("B" & iRow - 1).Value 'on inscrit le mois en A3
    sWkM.Activate
    [A6].Offset(0, Day(Date)).Select
Else
    [Année].Select 'sinon on se place sur l'année pour pouvoir la changer..?
End If
'
Application.EnableEvents = True
Application.ScreenUpdating = True
'
End Sub

A+

Merci mille fois

J'ai quand même un problème encore. Je n'arrive pas a aller sur la feuille annuel elle s'affiche et ce repositionne sur la feuille mensuelle.

Merci d'avance

Salut Michel,

C'est vrai que ce n'est pratique que pour la démonstration!

Supprime ceci :

    sWkM.Activate
    [A6].Offset(0, Day(Date)).Select

A+

Ça fonctionne merci super

J'ai encore, je pense, une dernière demande.

J'aimerais pouvoir rajouter cette petite fonction dans le page mensuel.

Quand je clique sur une case des jours ça affiche l'horaire selon tableau B14 D 34

Je joins l'exemple

Merci encore une fois de vos services

Salut Michel,

si tu veux un service complet, il faut fournir un fichier complet et des demandes complètes et non par bribes et morceaux, stp!

En fait, c'est pouvoir choisir l'horaire pour chaque jour : une validation de données?
Autre chose?

A+

j'aimerais que dans la feuille mensuelle le curseur se positionne sur la date du jour et affiche dans la cellule N3 en fonction du tableau A14/D34

Et quand je clique sur une autre case, ça m'affiche l'horaire de travail selon la correspondance du tableau

Je sais pas si c'est compréhensible comme ça

Merci de vous occuper d'un incapable

Salut Michel,

c'est fait mais j'ai un petit problème de chargement de fichier...
Je t'enverrai ça dès que possible!

A+

Encore merci

Bête question, Michel,

je ne connais pas la globalité de ton fichier, évidemment, mais quel est l'intérêt de la feuille 'Mensuel' ?
Juste la consultation actuelle et l'affichage de la correspondance des codes journaliers ?
Tu pourrais l'avoir dans la feuille 'Annuel' tout pareil !

A+