Collage spécial

[dufagri]

Bonjour,
J'ai cette commande qui me permet de copier une partie d'une feuille afin d'archiver les données. En l'état, j'ai fait un collage spécial "valeurs et formats des nombres afin de bien stocker des valeurs numériques et pas des formules qui renverraient vers des classeurs qui seront ensuite déplacé. Par contre, je perds toute ma mise en forme. Comment faire pour faire un copiage spécial où j'enregistrerais bien les valeurs des nombres, mais aussi le format des cellules ?

Sub Enregistrement()
Dim strChemin As String
Dim strNomFic As String
' Si le nom du fichier n'est pas saisi, message alerte et on ne fait rien
strNomFic = Range("C6").Value
strChemin = Range("B14").Value
'détection de critère manquan
If strNomFic = "" Or strChemin = "" Then
MsgBox "Le nom du client et le n° de la Facture doivent être saisie pour permettre l'enregistrement", vbCritical, "Enregistrement impossible"
Exit Sub
End If
'début test
Columns("A").Select
Range("A8").Activate
Application.CutCopyMode = False
Selection.Copy


' Enregistrement
Workbooks.Add
Columns("A:A").Select

Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False

ActiveWorkbook.SaveAs Filename:= _
"C:\Documents and Settings\PRESTIAGRI\Mes documents" & "\" & strNomFic & strChemin, FileFormat:=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWindow.Close
End Sub

Merci

 

[titcoeur]

Re : Collage spécial

Salut Dufagri

En dessous de ta ligne en rouge , ajoute :


Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

oubien remplace les deux par ceci si tu ne veux que les format des nombres (et pas les cadres etc)

Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False


Au fait, comment fais tu pour mettre du texte en rouge ?
A+

 

[Gorfael]

Re : Collage spécial

Salut dufagri et le forum

Sub Enregistrement()
Dim strChemin As String
Dim strNomFic As String
 
If isempty(Range("C6")) Or isempty(Range("B14")) Then
MsgBox "Le nom du client et le n° de la Facture doivent être saisie pour permettre l'enregistrement", vbCritical, "Enregistrement impossible"
Exit Sub
End If
strNomFic = Range("C6")
strChemin = Range("B14")
'début test
Columns("A:D").Copy
 
' Enregistrement
Workbooks.Add
[COLOR=black][A1].PasteSpecial Paste:=xlPasteValuesAndNumberFormats[/COLOR]
[A1].PasteSpecial Paste:=xlPasteFormats
 
ActiveWorkbook.SaveAs Filename:= _
"C:\Documents and Settings\PRESTIAGRI\Mes documents" & "\" & strNomFic & strChemin, FileFormat:=xlNormal,
ActiveWindow.Close
End Sub

A+