Copier onglet dans un nouveau classeur (VBA)
Bonjour à tous,
dans l'exemple ci-joint je veux exporter l'onglet dans un nouveau classeur sans formules, sans bouton macro et sans codes VBA
le noms et la couleur de l'onglet seront les mêmes que ceux d'origine
le nom du classeur sera le nom de l'onglet + la date qui se trouve dans la dernière partie de la cellule E1 c'est a dire le nom du classeur dans cet exemple sera CAP Congés (MENS) 06-2016
supprimer les cellules D34 et D35 de l'onglet copié tout en sachant que ces cellules sont variables et leur emplacement peut être dans D39 et D40 ou même D88 et D89, cela dépend des lignes du tableau qui est variable dans mon classeur d'origine.
Merci d'avance
Bonjour,
Une proposition à tester.
Cdlt.
Public Sub Export()
Dim wb As Workbook
Dim ws As Worksheet
Dim sPath As String, sFilename As String
Dim lRow As Long
Application.ScreenUpdating = False
Set wb = ActiveWorkbook
Set ws = wb.Worksheets("CAP Congés (MENS)")
sPath = wb.Path & Application.PathSeparator
sFilename = ws.Name & Right(ws.Cells(5), 8)
ws.Copy Workbooks.Add.Worksheets(1)
With ActiveSheet
lRow = .Cells(.Rows.Count, 4).End(xlUp).Row
.Cells(lRow, 4).CurrentRegion.Clear
.Shapes.Range(Array("Button 1")).Delete
End With
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs _
Filename:=sPath & sFilename & ".xlsx"
ActiveWorkbook.Close
Application.DisplayAlerts = True
Set ws = Nothing
Set wb = Nothing
End SubBonsoir Jean-Eric merci beaucoup pour votre réponse elle répond sur ce que je cherchais sauf qu'après avoir testé votre code j'ai constaté qu'il manque encore des choses a rectifier si c'est possible
1***en ouvrant le fichier copié vous trouverez que les formules sont toujours présentes (exemple : la colonne H)
2***un onglet qui s'appelle feuil1 s'est ajouté a l'onglet copié chose que je ne désire pas avoir dans mon résultat
3***si j'ai 4 boutons de macro dans ma feuille le code ne supprime que le premier bouton qui s'appelle bouton1, alors qu'il faut enlever tout les boutons présents dans l'onglet.
j'espère que vous puissiez résoudre ces deux petits problèmes
Cordialement
Koikili
Bonjour,
A tester (en cliquant sur bouton Exporter).
Sub ExportFeuille()
Dim nom, n0%, n1%, wb As Workbook, sh As Shape, nm As Name
With ActiveSheet
nom = Split(.Range("E1").Value)
nom = .Name & " " & nom(UBound(nom)) & ".xlsx"
.Copy
End With
Set wb = ActiveWorkbook
wb.SaveAs ThisWorkbook.Path & "\" & nom
With wb
For Each sh In .Worksheets(1).Shapes
sh.Delete
Next sh
For Each nm In .Names
nm.Delete
Next nm
With .Worksheets(1)
n0 = .Cells(.Rows.Count, 1).End(xlUp).Row
.Range("A1:N" & n0).Value = .Range("A1:N" & n0).Value
n1 = .Cells(.Rows.Count, 4).End(xlUp).Row
.Rows(n0 + 1 & ":" & n1).Delete
End With
.Save
End With
End SubCordialement.
Bonjour,
Essaie avec cette nouvelle procédure.
Cdlt.
Option Explicit
Public Sub Export()
Dim wb As Workbook, WBNew As Workbook
Dim ws As Worksheet
Dim sPath As String, sFilename As String
Dim lRow As Long
Application.ScreenUpdating = False
'-------------------------------------------------------
Set wb = ActiveWorkbook
Set ws = wb.Worksheets("CAP Congés (MENS)")
sPath = wb.Path & Application.PathSeparator
sFilename = ws.Name & Right(ws.Cells(5), 8)
'-------------------------------------------------------
ws.Cells.Copy
Set WBNew = Workbooks.Add(xlWBATWorksheet)
With WBNew.Worksheets(1)
.Name = ws.Name
With .Cells(1)
.PasteSpecial xlPasteValuesAndNumberFormats
.PasteSpecial xlFormats
.PasteSpecial xlPasteColumnWidths
End With
Application.CutCopyMode = False
lRow = .Cells(.Rows.Count, 4).End(xlUp).Row
.Cells(lRow, 4).CurrentRegion.Clear
.Buttons.Delete
.Cells(1).Select
End With
'-------------------------------------------------------
ActiveWindow.DisplayGridlines = False
'-------------------------------------------------------
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs _
Filename:=sPath & sFilename & ".xlsx"
ActiveWorkbook.Close
Application.DisplayAlerts = True
'-------------------------------------------------------
Set ws = Nothing
Set WBNew = Nothing: Set wb = Nothing
End SubBonjour,
Merci beaucoup jean eric c'est exactement ce que je cherchais