Enregistrer une feuille dans un autre classeur

PAPA WALKER

PAPA WALKER

XLDnaute Junior
Bonjour à tous,

Je viens chercher quelques conseils ou pistes pour le point suivant.

A partir d'un fichier multi-onglet, je souhaite enregistrer la feuille courant dans un autre fichier en suivant un chemin défini.

Jusque là, j'ai pu faire et j'ai trouvé du code que j'ai pu adapter, mais se pose plusieurs points que je ne maîtrise pas:

1°) Le Fichier Source pèse 7916Ko ce qui en soi est déjà beaucoup à mon sens vu son contenu.
2°) J'ai passé des scripts différents de nettoyage sur le fichier mais sans grand succès
3°) Si je sauvegarde l'onglet seul, il pèse quasiment le même poids?
4°) Si je fais un copier coller des valeurs, oui une copie de mis en forme dans un classeur vierge, il pède à peine 10Ko
5°) il y a des images dans l'entête et si je les rajoute, on fasse à 25 ou 30 Ko donc il y a un écar considérable entre le c=fichier créé et ce qui devrait être en ne considérant que les datas et les images?

j'ai essayé les deux codes suivants
Sub ColleEtSauveII()
Dim D_WKB As Workbook, Chemin As String, NFic As String
Dim Depart, Nom, Code, NOM2
Dim S_WKB As Workbook: Set S_WKB = ThisWorkbook
Dim MaPlage As Range
Set MaPlage = S_WKB.Worksheets(1).Range("A1:W65")
Chemin = Range("Z2").Value
Depart = Range("b18").Value2
Nom = Range("d13").Value2
Code = Range("c11").Value2
NOM2 = Depart & "-" & Nom & "-" & Code & ".xls"

Application.ScreenUpdating = False
MaPlage.Copy
Set D_WKB = Workbooks.Add(xlWBATWorksheet)
With D_WKB.ActiveSheet
.Paste
With .UsedRange
.Value = .Value
End With
End With
Application.CutCopyMode = False
D_WKB.SaveAs Chemin & NOM2
D_WKB.Close True
Application.ScreenUpdating = True
End Sub

Ce code me génère un fichier de 36KO ce qui est bien, mais j'ai perdu toute la mise en page concernant les hauteurs de lignes et les largeurs de colonnes

----------------------------------------
ub copiexlsPRESTA()

Dim Chemin, Depart, Nom, Code, NOM2 As String

Chemin = Range("Z2").Value
Depart = Range("b18").Value2
Nom = Range("d13").Value2
Code = Range("c11").Value2
NOM2 = Depart & "-" & Nom & "-" & Code
ActiveSheet.Copy
With ActiveWorkbook
.Title = NOM2
.Subject = NOM2
.SaveAs Filename:=Chemin + "\" + NOM2 + ".xls"
End With
End Sub

ce code ma génèré un fichier de 7872 Ko

Le but final était de sauvegarder l'onglet actif:

1°) Dans un autre fichier en le nommant d'après de svariables
2°) De remplacer les formules par des valeurs
3°) De conserver la mise en forme de l'onglet sauvegardé
4°) De limiter la taille de la sauvegarde.

Est-ce possible?

Merci de votre attention et de vos conseils à venir.
Ma version d'Excel est la 2016
 
Trier par date Trier par votes
Robert

Robert

XLDnaute Barbatruc
Repose en paix
Bonjour Papa Walker, bonjour le forum,

Peut-être comme ça :
VB: 
Sub ColleEtSauveII()
Dim CS As Workbook
Dim OS As Worksheet
Dim D As String
Dim CH As String
Dim N As String
Dim C As String
Dim Nom As String
Dim CD As Workbook
Dim I As Integer

Application.ScreenUpdating = False
Set CS = ThisWorkbook
Set OS = CS.ActiveSheet
D = OS.Range("B18").Value2
CH = OS.Range("Z2").Value
N = OS.Range("D13").Value2
C = OS.Range("C11").Value2
Nom = D & "-" & N & "-" & C & ".xls"
Set CD = Workbooks.Add
OS.Copy before:=CD.Sheets(1)
Application.DisplayAlerts = False
For I = CD.Sheets.Count To 2 Step -1
    CD.Sheets(I).Delete
Next I
Application.DisplayAlerts = True
CD.SaveAs CH & Nom
CD.Close True
Application.ScreenUpdating = True
End Sub
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Bonjour PAPA WALKER, Robert, le forum,

Sur Excel 2007 et versions suivantes il faut préciser le FileFormat (56) quand on veut sauvegarder en .xls.

Voyez le fichier joint et cette macro :
Code: 
Sub Sauvegarder()
Dim chemin$, nom$, MaPlage As Range, i&
chemin = ThisWorkbook.Path & "\" 'à adapter
nom = [B18].Text & "-" & [D13] & "-" & [C11] & ".xls"
Set MaPlage = ThisWorkbook.Worksheets(1).[A1:W65] 'à adapter
Application.ScreenUpdating = False
Application.DisplayAlerts = False 'si le fichier a déjà été créé
On Error Resume Next
Workbooks(nom).Close 'si le fichier est ouvert on le ferme
On Error GoTo 0
With Workbooks.Add(xlWBATWorksheet).Sheets(1)
    MaPlage.Copy .[A1]
    .UsedRange = .UsedRange.Value
    For i = 1 To MaPlage.Rows.Count
        .Rows(i).RowHeight = MaPlage.Rows(i).RowHeight
    Next
    For i = 1 To MaPlage.Columns.Count
        .Columns(i).ColumnWidth = MaPlage.Columns(i).ColumnWidth
    Next
    .SaveAs chemin & nom, 56 'fichier .xls
    .Parent.Close
End With
End Sub
A+
 

Pièces jointes

  • Sauvegarder(1).xlsm
    23.1 KB · Affichages: 39
Vote positif 0 Vote négatif
PAPA WALKER

PAPA WALKER

XLDnaute Junior
Robert à dit:
Bonjour Papa Walker, bonjour le forum,

Peut-être comme ça :
VB: 
Sub ColleEtSauveII()
Dim CS As Workbook
Dim OS As Worksheet
Dim D As String
Dim CH As String
Dim N As String
Dim C As String
Dim Nom As String
Dim CD As Workbook
Dim I As Integer

Application.ScreenUpdating = False
Set CS = ThisWorkbook
Set OS = CS.ActiveSheet
D = OS.Range("B18").Value2
CH = OS.Range("Z2").Value
N = OS.Range("D13").Value2
C = OS.Range("C11").Value2
Nom = D & "-" & N & "-" & C & ".xls"
Set CD = Workbooks.Add
OS.Copy before:=CD.Sheets(1)
Application.DisplayAlerts = False
For I = CD.Sheets.Count To 2 Step -1
    CD.Sheets(I).Delete
Next I
Application.DisplayAlerts = True
CD.SaveAs CH & Nom
CD.Close True
Application.ScreenUpdating = True
End Sub
Cliquez pour agrandir...


Bonjour Robert et merci pour ton retour,
J'ai testé ce code mais il m'a créé un fichier aussi lourd qu'avant, donc malheureusement ça n'a pas été concluant pour cette fois.
Par contre, le code un peu plus bas que m'a adressé JOB75, à l'air de bien fonctionner.
Quoiqu'il en soi, je te remercie chaleureusement
 
Vote positif 0 Vote négatif
PAPA WALKER

PAPA WALKER

XLDnaute Junior
job75 à dit:
Bonjour PAPA WALKER, Robert, le forum,

Sur Excel 2007 et versions suivantes il faut préciser le FileFormat (56) quand on veut sauvegarder en .xls.

Voyez le fichier joint et cette macro :
Code: 
Sub Sauvegarder()
Dim chemin$, nom$, MaPlage As Range, i&
chemin = ThisWorkbook.Path & "\" 'à adapter
nom = [B18].Text & "-" & [D13] & "-" & [C11] & ".xls"
Set MaPlage = ThisWorkbook.Worksheets(1).[A1:W65] 'à adapter
Application.ScreenUpdating = False
Application.DisplayAlerts = False 'si le fichier a déjà été créé
On Error Resume Next
Workbooks(nom).Close 'si le fichier est ouvert on le ferme
On Error GoTo 0
With Workbooks.Add(xlWBATWorksheet).Sheets(1)
    MaPlage.Copy .[A1]
    .UsedRange = .UsedRange.Value
    For i = 1 To MaPlage.Rows.Count
        .Rows(i).RowHeight = MaPlage.Rows(i).RowHeight
    Next
    For i = 1 To MaPlage.Columns.Count
        .Columns(i).ColumnWidth = MaPlage.Columns(i).ColumnWidth
    Next
    .SaveAs chemin & nom, 56 'fichier .xls
    .Parent.Close
End With
End Sub
A+
Cliquez pour agrandir...

Bonjour JOB75
Merci pour ton aide car ça semble parfaitement fonctionner :)
Je n'avais encore jamais vu ces boucles pour gérer les colonnes et les lignes et donc c'est une jolie découverte

Je vais à présent adapter le code pour imprimer l'onglet source avant de le sauvegarder et je pense que ça sera bon comme ça.

Un très grand merci car seul, je n'y serais pas arrivé ou alors dans ..... très très longtemps. :)
 
Vote positif 0 Vote négatif
PAPA WALKER

PAPA WALKER

XLDnaute Junior
Re bonjour,

Après quelques utilisations, il y a un souci qui demeure lors de la fermeture du fichier contenant le code VBA

"Cette image est trop grande et va être tronquée"

Le souci viendrait-il du nombre de lignes entre du XLSXM et du XLS?
Pourtant on ne copie qu'une plage réduite...

Si quelqu'un à une idée?
Merci d'avance


Le code utilisé

Sub SauvpRESTA()
Dim chemin$, nom$, MaPlage As Range, i&
chemin = "G:\SAUV\"
'chemin = ThisWorkbook.Path & "\" 'à adapter
nom = [B18].Text & "-" & [D13] & "-" & [C11] & ".xls"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
IgnorePrintAreas:=False
Set MaPlage = ThisWorkbook.Worksheets(1).[A1:W65] 'à adapter
Application.ScreenUpdating = False
Application.DisplayAlerts = False 'si le fichier a déjà été créé
On Error Resume Next
Workbooks(nom).Close 'si le fichier est ouvert on le ferme
On Error GoTo 0
With Workbooks.Add(xlWBATWorksheet).Sheets(1)
MaPlage.Copy .[A1]
.UsedRange = .UsedRange.Value
For i = 1 To MaPlage.Rows.Count
.Rows(i).RowHeight = MaPlage.Rows(i).RowHeight
Next
For i = 1 To MaPlage.Columns.Count
.Columns(i).ColumnWidth = MaPlage.Columns(i).ColumnWidth
Next
.SaveAs chemin & nom, 56 'fichier .xls
.Parent.Close
End With
End Sub
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Bonjour PAPA WALKER, Robert, le forum,
PAPA WALKER à dit:
"Cette image est trop grande et va être tronquée"
Cliquez pour agrandir...
Ce message est dû au fait qu'un objet est copié, voici 2 solutions :

- fichier (2) on ne copie pas les objets :
Code: 
    objets = Application.CopyObjectsWithCells 'mémorise
    Application.CopyObjectsWithCells = False 'objets non copiés
    MaPlage.Copy .[A1]
    Application.CopyObjectsWithCells = objets
- fichier (2 bis) les objets sont copiés mais on vide le presse-papiers :
Code: 
    .[A1].Copy .[A1] 'vide le presse-papiers
A+
 

Pièces jointes

  • Sauvegarder(2).xlsm
    26.5 KB · Affichages: 36
  • Sauvegarder(2 bis).xlsm
    26.5 KB · Affichages: 35
Vote positif 0 Vote négatif

Discussions similaires

F
  • Question
Microsoft 365 Poursuivre ou pas la macro
Réponses
2
Affichages
162
Francky79
F
C
  • Question
XL 2021 Dernière ligne d'un fichier fermé
Réponses
7
Affichages
162
Chris 33
C
C
  • Résolu(e)
XL 2021 enregistrer sous un sous répertoire en vba
Réponses
3
Affichages
436
cgpa
C
N
  • Question
XL 2021 Sauvegarde onglet
Réponses
10
Affichages
212
nano33320
N
halecs93
  • Question
Microsoft 365 Générer mail via Excel
Réponses
2
Affichages
196
halecs93
halecs93
P
  • Question
XL 2019 Copier des cellules d'une feuille sur une autre
Réponses
2
Affichages
210
phoceenjo
P
M
  • Question
Microsoft 365 Création fichier texte
2
Réponses
15
Affichages
142
patricktoulon
patricktoulon
M
  • Question
Microsoft 365 Macro VBA supprimer une colonne
Réponses
5
Affichages
86
marie3107
M
chris6999
  • Question
Microsoft 365 Conserver la valeur de ma variable pour l'utiliser dans un autre code
Réponses
3
Affichages
98
mapomme
mapomme
Nico2978
  • Résolu(e)
XL 2019 Aide pour un module d'archivage de feuille en pdf dans répertoire
Réponses
5
Affichages
156
Nico2978
Nico2978

Membres actuellement en ligne

24 membres et 456 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 079
Messages
2 085 136
Membres
102 790
dernier inscrit
nabilziad