Macro maintient menu deroulant

Bonjour,

Lorsque j'applique la macro ci dessous, les menus deroulant de ma feuille receptrice disparaissent.

je souhaiterais integrer un module qui permet de remettre ce menu deroulant provenant de la colonne N

Dans le fichier cela correspond aux cases AS cad lignes (9-14),( 18-23),(27-32) (37-42), (46-51), (55-60)

Merci

Sub reportASB2()

Application.ScreenUpdating = False

Set fd = ActiveWorkbook.Sheets("hebdo mise à jour")

dte = fd.Range("h4")

Windows("planning B2 AS.xlsm").Activate

Sheets("hebdoT").Activate

Set f = ActiveWorkbook.Sheets("hebdoT")

If CDate(f.Range("h3")) = dte Then

For k = 6 To 18 Step 6

For col = 5 To 11

f.Range(Cells(k, col), Cells(k + 5, col)).Copy

fd.Cells((6 * k) / 4, col).PasteSpecial xlPasteValues

f.Range(Cells(k + 21, col), Cells(k + 26, col)).Copy

fd.Cells((6 * k) / 4 + 28, col).PasteSpecial xlPasteValues

Next col

Next k

Else

MsgBox "Le planning hebdo de " & f.Name & " n'est pas de la même semaine que celui de destination", 16

End

End If

Sheets("hebdo").Activate

Range("C6:I35,C39:I68").Select

Selection.ClearContents

ActiveWorkbook.Close True

MsgBox "Travail terminé avec succès !"

End Sub

Bonjour,

Faut pas copier ! Si tu colles sur une une cellule à liste de validation, tu l'effaces.

Au lieu de copier, PlageDestination = PlageSource.

Cordialement

Ferrand

Bonjour (de grande anse!!!!)

J'ai compris l'erreur mais maintenant comment je l'integre dans ma macro.

merci

Bonsoir, fé noir (à La Saline)

Essaie sous cette forme :

fd.Cells((6 * k) / 4, col) = f.Range(Cells(k, col), Cells(k + 5, col))

qui demande le moins de modif. (Attention tu en as 2, je n'en ai mis qu'une mais le principe est le même)

Si cela ne veut pas marcher on passera par une variable (tableau ou plage).

A+

Ferrand

Bonjour

le code ne fonctionne pas. Il ne me rapporte pas les donnees.

Je vous envoie la page source des données (c'est le résultat d'une extraction de planning)

Merci de votre aide

tseoy

Bonjour,

Il me faut ton code avec les feuilles source et cible pour regarder ce qui se passe et tester les combinaisons jusqu'à ce qu'une fonctionne...

Bonjour

je t'envoie l'ensemble du fichier

dans le fichier AS deux onglets hebdo et hebdoT

Hebdo est l'extraction de base.

HebdoT sert pour le transfert.

je fais une manoeuvre manuelle pour les noms en dessous de la ligne verte de l'onglet hebdo. Je ne sais pas faire pour que si cela depasse 6 noms le reste se repositionne sur un autre étage

merci

Ya un truc ! Ou j'ai pas les yeux en face des trous, mais je ne vois pas l'onglet hedoT ?

Ah ! J'ai vu. Etait masquée.

Bon, sans affecter ce qui existe (j'aurais du mal à faire le tour complet...), à l'intérieur de la boucle For col essaie en remplaçant la copie par une affectation de cellule à cellule : une nouvelle boucle (sans toucher au reste) :

For m = 0 To 2
     fd.Cells((3 * k - 12) + m, col) = f.Cells(k + m, col)
     fd.Cells((3 * (k + 12)) - 20 + m, col) = f.Cells(k + 12 + m, col)
Next m

Cordialement

Ferrand

Merci beaucoup ca marche

As tu une idee de ce que je peux faire sur mon fichier AS pour eviter une intervention manuelle

c'est à dire que sur l'onglet hebdo tous les noms sous la ligne verte sont repositionnes sur un autre étage ou il y a de la place automatiquement?

encore merci

tseoy.

Re,

Je ne sais pas ce que ça fait mais c'est là que ça se passe :

For Each c In Range(Cells(lnB(k), 3 + t), Cells(lnC(k), 3 + t))
      If c.Value = "" Then
           c.Value = .Cells(i, j)
           Exit For
      End If
Next c

Tu fais écrire en dessous de la ligne verte, si on est arrivé au bout.

Difficile de te conseiller une mesure ponctuelle pour éviter ça, avec un boucle For Each Next on ne peut manipuler les indices à l'intérieur de la boucle, et de toute façon ne sachant pas ce qui se fait exactement je ne peux prévoir si cela n'aurait pas des effets dommageables. Il faut reprendre l'analyse globale de l'opération pour voir comment on peut opérer sans chevauchement avec les lignes intermédiaires.

Bonne fin de soirée

Ferrand

bonjour,

je te remercie beaucoup de ton aide

Je vais laisser le fichier comme cela et finir une autre macro;

Bonne journée

tseoy