VBA - Collage spécial valeur sur une même cellule

Bonjour,

code a mettre dans un module, ensuite voir comment le lancer:
_ a l'ouverture du fichier pour un tour

_ module tourne toute les x minutes

a vous de voir

Sub fige_taux()
    Dim mois, lig, col, compt
    
    Application.ScreenUpdating = False
    
    'mois courant
    mois = Month(Now())
    With Worksheets("feuil1")
        'derniere cellule non vide colonne A
        derlig = .Range("A" & Rows.Count).End(xlUp).Row
        'init compteur mois
        compt = 1
        'boucle ligne pas de 3
        For lig = 4 To derlig Step 3
            'test cellule Ax non vide
            If .Cells(lig, 1) <> "" Then
                'boucle colonne pas de 2
                For col = 6 To 28 Step 2
                    'test mois-1
                    If compt < 3 Then
                        'reecriture cellule
                        .Cells(lig, col) = .Cells(lig, col).Value
                    Else
                        'sortie boucle colonne
                        Exit For
                    End If
                    'increment compteur mois
                    compt = compt + 1
                Next col
                'init compteur mois
                compt = 1
            End If
        Next lig
    End With

    Application.ScreenUpdating = True
    
End Sub


'a lancer en cas de plantage pour rafraichissement feuille
Sub test()
    Application.ScreenUpdating = True
End Sub

A+

Bonjour f894009,

J'ai essayé votre code qui correspond à ce que je souhaite faire et je vous remercie. Cependant, il ne prend en compte que les colonnes F et H. Comment faire pour l'étendre jusqu'à AB?

Aussi le fichier final comprendra plusieurs tableaux construits sur le même modèle que ce dernier et je souhaiterais que le code s'applique pour ces tableaux également. Faut-il créer une boucle, un nouveau module? (il y aurait une ligne d'espace entre chaque tableau)

Merci pour votre aide.

Cordialement

PS: pour le lancement je pense qu'il se fera à l'ouverture du fichier.

Edit: en fait les mois ne sont pas au format date à partir de mars (c'est un oubli de ma part), mais même en les mettant au format date, ils ne sont pas pris en compte.

Re,

If compt < 3 Then------> remplacez 3 par mois-1 (j'avais mis 3 pour les tests)

Edit: en fait les mois ne sont pas d'importance, j'utilise le format de fichier pas le contenu des cellules

Aussi le fichier final comprendra plusieurs tableaux le meme module doit etre suffisant, c'est une logique de programmation. Vos tableaux seront de hauteurs variables ou fixes ?????

Merci,
La logique VBA n'est pas encore tout à fait évidente pour moi mais ça viendra...
J'ai fait la modification, cela fonctionne.

En ce qui concerne les autres tableaux ils sont identiques (8 lignes,32 colonnes), ils sont espacés d'une ligne et sont bien pris en compte.

Cependant, certains ont un espace de deux lignes et ils ne sont plus pris en compte par le code.

Re,

Il faut faire des tableaux de donnees pour avoir les infos par tableaux: ligne de depart, ligne de fin, pas des lignes a ecrire
de facon a ne pas tester si la cellule Ax est vide, ce qui actuellement fait sortir du code d'ecriture cellule

A+

Merci à vous je vais essayer d'écrire le code.

Bonjour f894009,

Je ne vois pas trop comment construire le code pour les tableaux. Pouvez-vous me donner un exemple?

Merci.

Bonjour,

J'ai relu vos messages pour raccrocher au sujet, je vous modifie votre fichier.

A+

Re,

Votre fichier de depart modifie:

https://www.cjoint.com/c/CGrrDNNb8i6

A adapter sur votre fichier de travail

A+

Bonjour

Voila une macro a tester bien sur
avec calcul de nombre de tableaux

Sub testMois()
VarMois = Val(Format(Now, "m"))
NumC = (VarMois * 2) + 3
With Feuil1
Coul = .Range("F4").Interior.ColorIndex
For L = 4 To .Range("K" & Rows.Count).End(xlUp).Row
If .Range("F" & L).Interior.ColorIndex = Coul Then
'Debug.Print L
Range(Cells(L, 6), Cells(L, NumC)).Copy
Range("F" & L).PasteSpecial xlPasteValues
Application.CutCopyMode = False
End If
Next
End With
End Sub

A+

Maurice