Export d'une plage de donnée Excel dans un nouveau Excel

Bonjour,

A partir d'un classeur existant, je souhaite en créer une copie :

1. En ne copiant que le contenu de la plage de donnée "A1:V164"
2. Conservant le même nombre d'onglet et leur même nom (j'ai pour le moment 3 onglets)
3. Positionnant le curseur sur la case A1 de chaque classeur
4. Ouvrir le premier onglet à l'ouverture du fichier
5. S'enregistrant sous le nom du classeur actif suivi de "_Validated"
6. Ne contenant aucune macro

L'idée est de générer ce fichier pour mes clients qui ne doivent pas avoir accès à certaines cases de mon classeur et de donner une mise en page propre au fichier (Ouvert sur l'onglet 1, à la case A1, tous les onglets en case A1)

J'ai tenté d'adapter un bout de code trouvé sur internet, j'arrive bien à enregistrer un nouveau classeur et conservant les noms d'onglets

Mais je n'arrive pas à passer le "_Validated" en suffixe et lors de l'ouverture du nouveau fichier j'ai un message d'erreur

"Le fichier que vous tentez d'ouvrir est différent de celui spécifié par l'extension de fichier..."

Ne me permet pas de recopier uniquement le contenu de "A1:V164"

J'ai bien essayé via la commande Range sans résultat:

wb.Sheets(n).Range("A1:V164").Copy after:=wbN.Sheets(wbN.Sheets.Count) 'Copie de tous les onglets

J'ai essayé de placer mon curseur dans A1 via select sans résultat

Idem pour ouvrir sur le premier onglet

Vous trouverez mon code actuel ci-dessous,

Merci de votre aide !

Julien

Sub save_movia()
    Dim wb As Workbook
    Dim wbN As Workbook
    Dim i As Integer, n As Integer, j As Integer

    Set wb = ThisWorkbook
    Application.ScreenUpdating = False
        Set wbN = Workbooks.Add()  ' nouveau classeur
       [b] wbN.SaveAs "Validated" & wb.Name 'renommer[/b]
        n = wbN.Sheets.Count    'onglet par défaut dans classeur
        For j = 1 To n
            wbN.Sheets(j).Name = " T_E_M_P_" & j  'nom temporaire pour éviter erreur
        Next j
    For i = 1 To wb.Sheets.Count
        [b]wb.Sheets(i).Copy after:=wbN.Sheets(wbN.Sheets.Count) 'Copie de tous les onglets[/b]
        Application.DisplayAlerts = False
    Next i
    For j = 1 To n
            wbN.Sheets(1).Delete  'effacer les onglets par défauts
        Next j
        Application.DisplayAlerts = True
        wbN.Save
        wbN.Close
        Set wbN = Nothing
    Application.ScreenUpdating = True
End Sub

Rebonjour,

Est-ce que quelqu'un saurait m'aider ?

Merci de votre aide,

Julien

Salut, j'ai travaillé avec borrougagnou sur un projet de changement d'extension de fichier, et d'après ce que tu nous dis, il est possible que ce soit ta manière de sauvegarder qu'Excel te reproche :

Dim myFile As String, myPath As String

myFile = ActiveWorkbook.Name
myPath = ActiveWorkbook.Path & Application.PathSeparator

ActiveWorkbook.SaveAs Filename:=myPath & myFile, FileFormat:=xlExcel8

En voilà un extrait qui permettait de récupérer le nom du fichier, l'emplacement de sauvegarde et l'enregistrer sous un autre format (exemple, cela permettait de passer de .csv à .xls -> Excel 97-2003, en rajoutant du code pour retirer le .csv du nom ou tout autre appellation

myFileCsv = Split(myFile, ".")

concrétement on retire le . et tout ce qu'il y a dérrière pour ne pas avoir à l'enregistrement : pomme.csv.xls mais pomme.xls)

Je ne sais pas si cela va t'aider, mais essaye, on sait jamais.

Merci Timothe pour ta réponse,

J'approche du but, le code en bas de se message permet de:

• Copier le contenu de chaque onglet ainsi que son nom
• Ne garder que la plage utile
• Positionner le curseur en A1
• Ouvrir le nouveau fichier sur le premier onglet
• S'enregistrer en "_Validated.xls"
• Supprimer les objets sauf ceux nommés "Image 2"

On s'approche déjà beaucoup du résultat attendu, cependant deux choses me gêne :

• les "Images 2" changent d'emplacement dans les feuilles de calcul copiées
• Je sélectionne bien la cellule A1 dans le but d'afficher pour tous les onglets le haut de la page,

Merci de votre aide,

Julien

Code actuel :

Sub save_movia()
    Dim wb As Workbook
    Dim wbN As Workbook
    Dim i As Integer, n As Integer, j As Integer

     If IsError(Cells(159, 21)) Then
     MsgBox ("Results are empty, please fill in the blanks")
     Else
        If Range("U159") <= 0.05 Then
            Call copy
        Else
            If MsgBox("Bus is above the accuracy limit, would you like to export the file anyway ?", vbYesNo, "Request confirmation") = vbYes Then 'Si le bouton Oui est cliqué
                Call copy
            End If

        End If
    End If
End Sub

Sub copy()
Dim chemin As String
Dim newname As String
Dim newname2() As String
Dim img As Object

Set wb = ThisWorkbook
newname = ActiveWorkbook.Name
    Application.ScreenUpdating = False
    chemin = ThisWorkbook.Path
        Set wbN = Workbooks.Add()  ' nouveau classeur
        Application.DisplayAlerts = False
        newname2 = Split(newname, ".")
        wbN.SaveAs Filename:=chemin & "\" & newname2(0) & "_Validated.xls", FileFormat:=xlExcel8 'renommer
        n = wbN.Sheets.Count    'onglet par défaut dans classeur
        For j = 1 To n
            wbN.Sheets(j).Name = " T_E_M_P_" & j  'nom temporaire pour éviter erreur
        Next j
    For i = 1 To n
        wb.Sheets(i).copy after:=wbN.Sheets(wbN.Sheets.Count) 'Copie de tous les onglets
        ActiveSheet.Unprotect
        Range("W1:AJ175").Clear
        Range("A1").Select
        For Each img In ActiveSheet.Shapes 'suppression image sauf image formule
        If img.Name <> "Image 2" Then img.Delete
    Next
        'Application.DisplayAlerts = False
        'Set wbN = Nothing
    Next i
        For j = 1 To n
            wbN.Sheets(1).Delete  'effacer les onglets par défauts
        Next j
        Application.DisplayAlerts = True
        wbN.Sheets(1).Select
        wbN.Save
        MsgBox ("Validated xls file is created in the current directory :" & chemin & "\")
        wbN.Close
    Application.ScreenUpdating = True
End Sub