XL 2013 copier une feuille a partir d'un classeur sans conserver les formules

chac10

XLDnaute Junior
Supporter XLD
Bonsoir à tous,

je souhaiterais copier des feuilles à partir d'un classeur vers un autre classeur sans conserver les formules.
La particularité, c'est que je souhaiterais aussi avoir la possibilité de copier une partie variable dans un nouveau classeur ( celle de mon choix; exemple un tableau ) et ou une ou plusieurs feuille complète.
C'est peut être du domaine du rêve mais bon je pose tout de même la question, sait on jamais ! :)

Merci à tous,

Chac10
 

Patrice33740

XLDnaute Impliqué
Bonjour,

Exemple générique :
VB:
Sub Test()
Dim rngSource As Range
Dim celCible As Range
 
  Set rngSource = Workbooks("Classeur1").Worksheets("Feuil1").Range("B12:T55")
  Set celCible = Workbooks("Classeur2").Worksheets("Feuil2").Range("C13")
  rngSource.Copy Destination:=celCible  'copie tout notamment les formats
  celCible.Resize(rngSource.Rows.Count, rngSource.Columns.Count).Value = rngSource.Value ' copie les valeurs
 
End Sub
Si tu ne veux que les valeurs, supprimes la ligne :
Code:
  Set celCible = Workbooks("Classeur2").Worksheets("Feuil2").Range("C13")
 

job75

XLDnaute Barbatruc
Bonsoir chac10, Patrice33740,

Dans le fichier .xlsm à copier placez cette macro dans un module standard :
VB:
Sub Exporter()
'dans les feuilles les plages à copier (plus d'une cellule) doivent avoir été sélectionnées
Dim F As Object, wb As Workbook, w As Worksheet, n%, P As Range, nf$
Application.ScreenUpdating = False
Set F = ActiveSheet
Set wb = Workbooks.Add(xlWBATWorksheet) 'nouveau document contenant une seule feuille
For Each w In ThisWorkbook.Worksheets
    w.Activate
    If Selection.CountLarge > 1 Then
        n = n + 1
        If n > 1 Then wb.Sheets.Add After:=wb.Sheets(wb.Sheets.Count) 'crée une feuille
        wb.Sheets(wb.Sheets.Count).Name = w.Name 'nomme la feuille
        w.Activate
        w.Cells.Copy wb.Sheets(w.Name).Cells(1) 'pour copier les formats
        wb.Sheets(w.Name).UsedRange.ClearContents 'RAZ
        Set P = Intersect(Selection, w.UsedRange)
        If Not P Is Nothing Then wb.Sheets(w.Name).Range(P.Address) = P.Value 'copie les valeurs
    End If
Next
'---enregistrement et fermeture---
nf = ThisWorkbook.Path & "\TOTO.xlsx" 'adapter le chemin et le nom du fichier
If Dir(nf) <> "" Then Kill nf 'si le fichier a déjà été créé il est supprimé
If n Then wb.SaveAs nf, 51 '51 => fichier .xlsx
wb.Close
F.Activate
MsgBox IIf(n, "Le fichier '" & nf & "' a été créé." & vbLf & "Il contient " & n & " feuille" & IIf(n = 1, ".", "s."), "Aucun fichier créé...")
End Sub
Avant de l'exécuter sélectionnez dans les feuilles les plages que vous voulez copier.

Les sélections doivent comporter plus d'une cellule et peuvent comporter toutes les cellules.

Bonne nuit.
 
Dernière édition:

chac10

XLDnaute Junior
Supporter XLD
1615684369261.png
1615684417144.png




Bonsoir messieurs,

j'ai pris la 2ème solution, la première ne m'a rien donné.
Je dois mal mis prendre, vraiment désolé Patrice33740
Job 75, j'ai copié dans un module standard enfin j'espère.
J'ai tenté de modifier le chemin et le nom du fichier sans résultat.
De plus, lorsque je lance la macro , la duplication se fait bien mais j'ai un message d'erreur, certainement a cause de ma écriture erronée. Voir ci dessous.
Je vous remercie tous les deux !
 

Pièces jointes

  • test.xlsm
    18.7 KB · Affichages: 10
Dernière édition:
Bonjour Chac10, le fil, le forum

dans le code de Job75
nf = ThisWorkbook.Path & "\TOTO.xlsx" 'adapter le chemin et le nom du fichier
signifie le chemin du fichier créé la ou est enregistré le classeur exécutant la macro
la tu essayes d'écrire sur le bureau admin et ton \. après le nom du fichier ne veut rien dire
pour copier sur ton bureau, fais plutôt
VB:
Dim Objet_Shell
    Set Objet_Shell = CreateObject("WScript.Shell") 'on cree un object wscriptshell
    nf = Objet_Shell.SpecialFolders("Desktop") & "\test.xlsx"  'on mémorise le chemin du fichier sur le bureau'adapter le chemin et le nom du fichier
    Set Objet_Shell = Nothing 'on libère l'objet
If Dir(nf) <> "" Then Kill nf 'si le fichier a déjà été créé il est supprimé
et ne modifies pas le code qu'on t'a donné n'importe comment, ne touches pas à la ligne
Code:
If Dir(nf) <> "" Then Kill nf 'si le fichier a déjà été créé il est supprimé
elle fait exactement ce qui est écrit, ce que tu as modifié provoque une erreur, tu essayes de supprimer un fichier que tu testes n'existant pas -> erreur

Cordialement
 

chac10

XLDnaute Junior
Supporter XLD
Bonjour Chac10, le fil, le forum

dans le code de Job75
nf = ThisWorkbook.Path & "\TOTO.xlsx" 'adapter le chemin et le nom du fichier
signifie le chemin du fichier créé la ou est enregistré le classeur exécutant la macro
la tu essayes d'écrire sur le bureau admin et ton \. après le nom du fichier ne veut rien dire
pour copier sur ton bureau, fais plutôt
VB:
Dim Objet_Shell
    Set Objet_Shell = CreateObject("WScript.Shell") 'on cree un object wscriptshell
    nf = Objet_Shell.SpecialFolders("Desktop") & "\test.xlsx"  'on mémorise le chemin du fichier sur le bureau'adapter le chemin et le nom du fichier
    Set Objet_Shell = Nothing 'on libère l'objet
If Dir(nf) <> "" Then Kill nf 'si le fichier a déjà été créé il est supprimé
et ne modifies pas le code qu'on t'a donné n'importe comment, ne touches pas à la ligne
Code:
If Dir(nf) <> "" Then Kill nf 'si le fichier a déjà été créé il est supprimé
elle fait exactement ce qui est écrit, ce que tu as modifié provoque une erreur, tu essayes de supprimer un fichier que tu testes n'existant pas -> erreur

Cordialement
bonjour Messieurs,

je suis parvenu a corriger merci beaucoup à tous les deux.
C'est une belle équipe :)

chac10
 

job75

XLDnaute Barbatruc
Il y avait une coquille, j'ai refait le post.

Bonjour chac10, Yeahou,

Oui chac10 vous avez modifié le code sans comprendre, c'est toujours dangereux.

Et nommer le fichier de destination test.xlsx n'est pas bien fameux, il vaut mieux Export.xlsx.

Utilisez le fichier joint et cette macro sans la modifier :
VB:
Sub Exporter()
'dans les feuilles les plages à copier (plus d'une cellule) doivent avoir été sélectionnées
Dim F As Object, wb As Workbook, w As Worksheet, n%, P As Range, nf$
Application.ScreenUpdating = False
Set F = ActiveSheet
Set wb = Workbooks.Add(xlWBATWorksheet) 'nouveau document contenant une seule feuille
For Each w In ThisWorkbook.Worksheets
    w.Activate
    If Selection.CountLarge > 1 Then
        n = n + 1
        If n > 1 Then wb.Sheets.Add After:=wb.Sheets(wb.Sheets.Count) 'crée une feuille
        wb.Sheets(wb.Sheets.Count).Name = w.Name 'nomme la feuille
        w.Activate
        w.Cells.Copy wb.Sheets(w.Name).Cells(1) 'pour copier les formats
        wb.Sheets(w.Name).UsedRange.ClearContents 'RAZ
        Set P = Intersect(Selection, w.UsedRange)
        If Not P Is Nothing Then wb.Sheets(w.Name).Range(P.Address) = P.Value 'copie les valeurs
    End If
Next
'---enregistrement et fermeture---
nf = "C:\Users\Admin\Desktop\Export.xlsx" 'adapter le chemin et le nom du fichier à créer
'nf = ThisWorkbook.Path & "\Export.xlsx" 'plus facile pour tester
If Dir(nf) <> "" Then Kill nf 'si le fichier a déjà été créé il est supprimé
If n Then wb.SaveAs nf, 51 '51 => fichier .xlsx
wb.Close
F.Activate
MsgBox IIf(n, "Le fichier '" & nf & "' a été créé." & vbLf & "Il contient " & n & " feuille" & IIf(n = 1, ".", "s."), "Aucun fichier créé...")
End Sub
Nota 1 : quand les 2 fichiers sont dans le même dossier mieux vaut utiliser ThisWorkbook.Path

Nota 2 : j'ai supprimé l'instruction pour alléger la mémoire, elle ne servait à rien.

A+
 

Pièces jointes

  • test.xlsm
    20.2 KB · Affichages: 3

Discussions similaires

Membres actuellement en ligne

Statistiques des forums

Discussions
294 371
Messages
1 938 081
Membres
188 641
dernier inscrit
pcayet