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

M
  • Résolu(e)
XL 2013 VBA enregistrement fichier dans un dossier en particulier
Réponses
3
Affichages
312
MarineU
M
Chaton77
  • Résolu(e)
Microsoft 365 Vba : Transférer des données d'un tableau dans un autre fichier
Réponses
7
Affichages
404
Chaton77
Chaton77
F
  • Question
Microsoft 365 Problème avec VBA ( Résolu)
Réponses
2
Affichages
299
firecarl
F
A
  • Résolu(e)
Microsoft 365 Enregistrer copie d'un fichier avec pour nom le contenu d'une cellule excel (macro)
2
Réponses
15
Affichages
788
firecarl
F
S
  • Question
Microsoft 365 Enregistrer les images dans un dossier
Réponses
2
Affichages
262
Simon 1234
S
J
  • Question
Microsoft 365 Code VBA
Réponses
10
Affichages
745
jebibo
J
P
  • Question
Microsoft 365 Priorité d'affichage lien hypertexte
Réponses
0
Affichages
191
PeteToulon
P
P
  • Question
XL 2019 Changer nom d'export en VBA
Réponses
3
Affichages
483
job75
job75
F
  • Question
Microsoft 365 Changement de fonctionnement d'une macro suite au passage à windows 10
Réponses
1
Affichages
450
francha62
F
L
  • Question
XL 2016 Ajout d'une requête SQL dans code VBA
Réponses
3
Affichages
266
Phil69970
Phil69970

Membres actuellement en ligne

17 membres et 152 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
315 085
Messages
2 116 071
Membres
112 648
dernier inscrit
Otete Christian