Discussion :

[Dynomax80]

Bonjour,

Je suis en train de faire une macro.

Mon objectif c'est de sélectionner 2 feuilles d'un fichier que je veux copier pour enregistrer sous un nouveau fichier avec un nom prédéfinie.

J'ai regardé sur internet pour trouver des idées et essayer de faire par moi même.

j'ai essayer les macro 1 à 1 et ça marche mais lorsque j'ai tout regrouper en une macro, ça ne veut pas marcher et cela me met comme message d'erreur "erreur de compilation : instruction incorrecte dans une procédure"

Voici la macro en question :

Sub save_cde()

Sheets(Array("cde transport", "copie colle facture")).Select
Sheets("copie colle facture").Activate
Sheets(Array("cde transport", "copie colle facture")).Copy


Dim sChemin As String, sFichier As String
Dim wkb As Workbook
Application.ScreenUpdating = False
sChemin = ThisWorkbook.Path & "\"
sFichier = "Commande Amont Roye du " & Feuil1.Range("P6") & ".xlsm"

If NomFichierValide(sFichier) Then
ActiveWorkbook.SaveCopyAs Filename:=sChemin & sFichier

Set wkb = Workbooks.Open(sChemin & sFichier)
SuppShapes wkb
Application.DisplayAlerts = False
wkb.SaveAs Filename:=sChemin & sFichier
wkb.Close
Set wkb = Nothing
With Application
.DisplayAlerts = True
.ScreenUpdating = True
End With
Else
With Feuil1
.Activate
.Range("C").Select
End With
MsgBox "Nom de fichier invalide", vbOKOnly + vbInformation
End If


' suppr_bouton Macro
'
ActiveSheet.DrawingObjects.Delete

End Sub

Private Function NomFichierValide(sChaine As String) As Boolean
Dim I As Long
Const CaracInterdits As String = """*/:<>?[\]|"
NomFichierValide = True
If Len(sChaine) = 0 Then
NomFichierValide = False
Exit Function
End If
For I = 1 To Len(CaracInterdits)
If InStr(sChaine, Mid$(CaracInterdits, I, 1)) > 0 Then
NomFichierValide = False
Exit Function
End If
Next I
End Function

End Sub

[curt]

Bonjour,

enlève le

Code :

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

End Sub

placé injustement à la fin
De plus, il manque sans doute la fonction SuppShapes

[Philippe Tulliez]

Bonjour,

Mon objectif c'est de sélectionner 2 feuilles d'un fichier que je veux copier pour enregistrer sous un nouveau fichier avec un nom prédéfinie.

En fait vous avez trois étapes à effectuer

1. Copier une ou plusieurs feuilles dans un nouveau classeur
2. Vérifier si son nom ne comprends pas des caractères prohibés
3. Sauver le nouveau classeur avec le nom vérifié

Créez donc trois procédures génériques avec les arguments qui s'imposent que vous invoquerez depuis une autre procédure

Exemple pour la première étape :
J'utilise une fonction nommée CopySheets qui me renvoie un objet Workbook représentant le nouveau classeur

Code de la procédure nommée CopySheets

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
47
48
49
50
Function CopySheets(SheetsList As Variant, Optional oWorkbook As Workbook) As Workbook
  ' Renvoie un objet classeur représentant le nouveau classeur contenant les copies
  '    Les feuilles à copier doivent provenir d'un même classeur
  ' Author  : Philippe Tulliez (www.magicoffice.be)
  ' Version : 1.2
  ' Arguments
  '   SheetsList        Array ou String contenant le nom des feuilles à copier
  '                      si String : propriété Name des feuilles à copier (le séparateur doit être un ;)
  '                      si Array  : propriété CodeName des feuilles à copier
  '   [oWorkbook]       Objet Workbook parent des feuilles à copier (d:=ActiveWorkbook)
  '
  ' Déclaration et assignation des variables
  Dim Sht As Worksheet  ' Objet feuille utilisé dans la boucle
  Dim Nwk As Workbook   ' Objet représentant le nouveau classeur construit avec les feuilles copiées
  Dim Shn As Integer    ' Variable de la boucle
  Dim CnC As Byte       ' Compteur des copies
  Dim Tbl As Variant    '
  If oWorkbook Is Nothing Then Set oWorkbook = ActiveWorkbook
  If TypeName(SheetsList) = "String" Then
     Tbl = Split(SheetsList, ";")
    Else
     Tbl = SheetsList
  End If
  For Shn = LBound(Tbl) To UBound(Tbl)
    With oWorkbook
     For CnC = 1 To .Worksheets.Count
      If StrComp(.Worksheets(CnC).CodeName, Tbl(Shn), vbTextCompare) = 0 Then
          Tbl(Shn) = .Worksheets(CnC).Name
      End If
     Next
   End With
  Next
  '
  With oWorkbook
    CnC = 0
    For Shn = LBound(Tbl) To UBound(Tbl)
      Set Sht = .Worksheets(Tbl(Shn))
      ' Copie des feuilles répondant aux critères
      If CnC Then
         Sht.Copy After:=Nwk.Worksheets(Nwk.Worksheets.Count)
        Else
         Sht.Copy
         Set Nwk = ActiveWorkbook
         CnC = CnC + 1
      End If
    Next
  End With
  Set CopySheets = Nwk
  Set Nwk = Nothing: Set Sht = Nothing
End Function

Exemple d'une procédure qui l'invoque
Dans cet exemple, on copie dans un nouveau classeur, les feuilles nommées Accueil, Achat et Vente du classeur actif
Il reste donc à ajouter les étapes 2 et 3

Code :

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

1
2
3
4
5
6
7
8
9
10
11
Sub Test_CopySheets()
  ' Déclaration
  Dim wkb As Workbook
  ' Copie des feuilles dans un nouveau classeur
  ' Etape 1
  Set wkb = CopySheets("Accueil;"Vente";"Achat")
  ' Etape 2 - Vérification de la validité du nom du classeur 
  ' Etape 3 - Sauver le nouveau classeur
  ' Fin
  set wkb = Nothing
End Sub

[Dynomax80]

Bonjour,

enlève le

Code :

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

End Sub

placé injustement à la fin
De plus, il manque sans doute la fonction SuppShapes

Bonjour,

Je l'ai enlevé, effectivement il ne servait pas.

Pour la fonction SuppShapes effectivement il me dit qu'il y a un soucis. Mais quand j'ai tester ce code tout seul, il marchait sans soucis et je ne comprend pas pourquoi avec les 2 autres il coince.

[Dynomax80]

j'ai repensé ma macro du début et j'arrive au résultat voulu.

Sujet clos mais j'arrive pas à le supprimer.

[deedolith]

Ne supprime pas le sujet,
mais poste ta solution, afin d'en faire profiter des personnes ayant un problème similaire au tien.

[Dynomax80]

Voici ma solution ou je copie une feuille pour l'enregistrer avec un nom prédéfini avec une date (date format texte)

Sub Save_cde()

Sheets(Array("cde transport")).Select
Sheets(Array("cde transport")).Copy

' suppr_bouton Macro
'
ActiveSheet.DrawingObjects.Delete


'enregistrer la commande

ActiveWorkbook.SaveAs Filename:="C:\Users\mvalentin\Desktop\test excel\Commande Amont Roye du " & Feuil1.Range("P6"), FileFormat:=51

End Sub

[Philippe Tulliez]

Bonjour,
La méthode Select ne sert strictement à rien dans votre code et de plus dans votre demande initiale vous évoquiez la copie de deux feuilles or là vous n'en copiez qu'une.
De plus vous deviez contrôler la validité du nom du classeur or on n'en trouve nulle trace dans votre code publié

Curieux. Vous avez peur de partager ?