Logo GNT
Actualités Tests & Guides Bons Plans
Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11
Entraide Applications Microsoft Office Excel Sauvegarde de la feuille1 dans un autre répertoire

Sauvegarde de la feuille1 dans un autre répertoire

2 réponses
Avatar
Peponne31
Bonsoir à tous,

je sollicite votre aide pour ce qui est pour moi un casse tête,
actuellement les enregistrements des feuilles se font dans le même
répertoire que le classeur. Je voudrais enregister ma feuille1!Devis
dans un répertoire devis et ma feuille2!Facture
pardi dans un répertoire facture
Voici se que j'ai comme code:
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Range("numdevis1").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False


'Imprime le devis
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Range("J6").Select

Sheets("journaldevis").Select
Application.Goto Reference:="jdnumclient"
ActiveCell.FormulaR1C1 = "=devis1page!code"

Application.Goto Reference:="jdnomclient"
ActiveCell.FormulaR1C1 = "=devis1page!dnomcli1"

Application.Goto Reference:="jddate"
ActiveCell.FormulaR1C1 = "=devis1page!date"

Application.Goto Reference:="jdht"
ActiveCell.FormulaR1C1 = "=devis1page!dht"

Application.Goto Reference:="jdremise"
ActiveCell.FormulaR1C1 = "=devis1page!dremise"

Application.Goto Reference:="jdtva"
ActiveCell.FormulaR1C1 = "=devis1page!mtva"

Application.Goto Reference:="jdttc"
ActiveCell.FormulaR1C1 = "=devis1page!fttc"

Sheets("devis1page").Select

Range("code").Select
Sheets("journaldevis").Select
Application.Goto Reference:="zonefin"
Selection.EntireRow.Insert
Application.Goto Reference:="zonereport"
Selection.Copy
Application.Goto Reference:="zonefin"
ActiveCell.Offset(-1, 0).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
ActiveCell.Offset(0, 3).Select
Selection.NumberFormat = "d/m/yy"

Application.Goto Reference:="zonereport2"
Selection.ClearContents

'réouvre le fichier devis 1 page

Sheets("devis1page").Select

'dupliquer le devis dans un nouveau
'classeur et effacer le code et le bouton
'imprimer

Dim VbComp As Object
Dim Wk As Workbook

ThisWorkbook.Sheets("devis1page").Copy

Set Wk = ActiveWorkbook
Set VbComp = Wk.VBProject.VBComponents("Feuil6")
With VbComp.CodeModule
.DeleteLines 1, .CountOfLines
End With
'enregistre et ferme la facture
Application.Dialogs(xlDialogSaveAs).Show
Wk.Close

Set VbComp = Nothing: Set Wk = Nothing

'efface le modèle devis
Range("B11:F13,B14:C15,E14:G15,I2,I12,B17:G18,A21:H50,I51,J6").Select
Selection.ClearContents
Range("J6").Select

Range("J6").Activate

'enregistre le classeur programme de devis et facture de maçonnerie
ActiveWorkbook.Save

Sheets("menu").Select

End Sub
Merci encore de bien vouloir éclairer de vos lumières une faible bougie.
Peponne31
Signaler un problème avec ce contenu

2 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Avatar
JB
Bonjour,

http://cjoint.com/?dmf7kE3Cnz

Sub essai()
Sheets("Devis").Copy
Application.DisplayAlerts = False
On Error Resume Next
MkDir "c:devis"
On Error GoTo 0
ActiveWorkbook.SaveAs "c:devisdevis.xls"
ActiveWindow.Close
Sheets("Facture").Copy
Application.DisplayAlerts = False
On Error Resume Next
MkDir "c:facture"
On Error GoTo 0
ActiveWorkbook.SaveAs "c:facturefacture.xls"
ActiveWindow.Close
End Sub

Cordialement JB
Avatar
Peponne31
Bonjour JB,
http://cjoint.com/?dmjiRixw5W

Merci pour ta réponse mais elle ne me convient pas,
je possède 4 feuilles pour devis et autant pour facture
et je voudrais que la formule face partie intégrante de la feuille.
et ce pour chaque feuille, sinon j'ai un message d'erreur
car je ne sais pas comment faire pourl'adapter à chaque feuille.Merci encore
Peponne31


Bonjour,

http://cjoint.com/?dmf7kE3Cnz

Sub essai()
Sheets("Devis").Copy
Application.DisplayAlerts = False
On Error Resume Next
MkDir "c:devis"
On Error GoTo 0
ActiveWorkbook.SaveAs "c:devisdevis.xls"
ActiveWindow.Close
Sheets("Facture").Copy
Application.DisplayAlerts = False
On Error Resume Next
MkDir "c:facture"
On Error GoTo 0
ActiveWorkbook.SaveAs "c:facturefacture.xls"
ActiveWindow.Close
End Sub

Cordialement JB