Bonjour
Me revoilà sur le même sujet. Cela fonctionne très bien avec le code de BsAlv que je remercie à nouveau.
Toutefois je voudrai faire un collage spécial "validation" ! j'ai essayé de modifier le code en ajoutant la ligne ci-dessous en remplacement de celle actuelle mais ça ne marche pas !
En effet dans la base de données où nous allons chercher les lignes à extraire selon la date pour les exporter dans un autre classeur, j'ai des listes déroulantes et des formules de calcul que je souhaite voir après collage sur la feuille du nouveau classeur.
Pourtant il me semble bien que le ".Paste" dans le code actuel équivaut à "coller tout" mais visiblement ce n'est pas le cas car je ne vois plus ni mes listes, ni mes formules et le format des colonnes n'est pas conservé ! On dirait au contraire qu'il ne copie que la valeur !
Comment faire svp pour modifier ce petit bout de code ?
.PasteSpecial Paste:=xlPasteValidation
mais ça ne fonctionne pas.
Sub exemple_inputbox()
MaDate = InputBox("Entrez une date au format JJ/MM/AA :", "Utilisateur")
'Si une valeur a été entrée et si l'utilisateur a cliqué sur OK
If MaDate <> "" Then
' MsgBox MaDate 'Renvoie le prénom entré
'MaDate = DateSerial(2023, 11, 30) 'votre date
Nom = Format(MaDate, "ddmmyyyy") 'nom de la feuille
sFichier = ThisWorkbook.Path & "\" & Nom & ".xlsx" 'chemin&nom du fichier
End If
With Sheets("TB DES FLP")
On Error Resume Next
.AutoFilter.Range.AutoFilter
On Error GoTo 0
With .Range("tableau1").ListObject.Range 'votre tableau
.AutoFilter 3, , xlFilterValues, Array(2, Format(MaDate, "mm/dd/yyyy")) 'filtrer le tableau
.SpecialCells(xlCellTypeVisible).Copy 'copier les cellules visibles
Set WB = Workbooks.Add 'nouveau fichier
Range("A7").Select
With ActiveSheet
.Paste 'coller les données
.Name = Nom 'nom de la feuille
End With
On Error Resume Next
Kill sFichier 'supprimer fichier eventuel dans ce sous-répértoire
On Error GoTo 0
WB.SaveAs Filename:=sFichier 'sauvegarder nouveau fichier
WB.Close SaveChanges:=False
.AutoFilter
End With
End With
End Sub
Vous remerciant par avance de l'aide que vous pourrez m'apporter.
Bien cordialement.
MK