Discussion :

[thespeedy20]

Bonjour le forum,

J'ai une feuille nommée Tarification, sur laquelle, je sélectionne un nom, et des chiffres apparaissent via formules...
je fais une copie de cette feuille dans onglet portant le même nom que celui du patient....

Ici les formules s'enlèvent bien mais la liste déroulante est dupliquée dans toutes les cellules de la copie....?

Est-il possible de régler ce problème de liste...?

Donc au final, enlever toutes les formules à partir de A9 jusqu’à la fin de la feuille et avoir une valeur unique dans la cellulle B15 qui la liste déroulante dans la feuille copiée

Je vous remercie pour votre aide

OLi

[Philippe Tulliez]

Bonjour,
Je n'ouvre jamais les fichiers joints et donc suivant les explications ci-dessous

Ici les formules s'enlèvent bien mais la liste déroulante est dupliquée dans toutes les cellules de la copie....?

Lorsque l'on copie le contenu d'une cellule, on copie en effet l'ensemble des propriétés de cette cellule (Value, Formula, Validation, Comment, etc.) comme dans l'exemple ci-dessous

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
Dim sht As Worksheet
Set sht = ThisWorkbook.Worksheets("Range")
With sht
.Range("B7").Copy Destination:=.Range("H7")
End With

Plusieurs options existent pour ne conserver qu'une parie des propriétés d'un objet Range. La méthode PasteSpecial de l'objet Worksheet en est une.
Cependant si l'on souhaite copier un objet Range contenant une Validation de données en conservant toutes ses propriétés à l'exception de cette dernière fonctionnalité on pourra écrire ce code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
Dim sht As Worksheet
Set sht = ThisWorkbook.Worksheets("Range")
With sht
.Range("B7").Copy Destination:=.Range("H7")
.Range("H7").Validation.Delete
End With
Set sht = Nothing

[thespeedy20]

Bonsoir Philippe Tulliez,


Pour la création de la premièrecopie de n’importe quel nom, cela fonctionne nickel :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
 
Sub EffForm()
    Dim oNewSheet As Excel.Worksheet
    Dim Nom As String
    Nom = Sheets("Tarification").Range("B15").Value
    Set oNewSheet = ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
    oNewSheet.Name = Nom
    oNewSheet.UsedRange.Formula = oNewSheet.UsedRange.Value
    oNewSheet.UsedRange.Validation.Delete
    Set oNewSheet = Nothing
 
End Sub

Par contre quand je dois dupliquer une autre feuille à la suite dans le répertoire de la personne, je sais pas comment m'y prendre

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
 
 
Sub CopierLaFeuilleADansB()
 
Dim ShSource As Worksheet
Dim LigneDeTitreSource As Long
Dim DerniereLigneSource As Long
Dim DerniereColonneSource As Long
Dim AireSource As Range
 
Dim ShCible As Worksheet
Dim DerniereLigneCible As Long
 
Dim NomOng As String
 
With Sheets("Tarification")
NomOng = Cells(15, 2).Value
End With
 
     'Sheets(ShCible).Select
     Set ShSource = Sheets("Tarification") ' A adapter
     Set ShCible = Sheets(NomOng) ' A adapter
 
 
     With ShSource
 
            LigneDeTitreSource = 1  ' A adapter
            DerniereLigneSource = 49
            DerniereColonneSource = 7
            Set AireSource = .Range(.Cells(LigneDeTitreSource, 1), .Cells(DerniereLigneSource, DerniereColonneSource))
 
     End With
 
     With ShCible
 
            DerniereLigneCible = .Cells(.Rows.Count, 2).End(xlUp).Row
                     'MsgBox DerniereLigneCible
            AireSource.Copy .Cells(DerniereLigneCible + 1, 1)
 
     End With
 
     Set AireSource = Nothing
     Set ShSource = Nothing
     Set ShCible = Nothing
 
End Sub

Pourriez-vous adapter ce dernier code ?

Merci d'avance

OLi