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

48copieronglet.xlsm (84.99 Ko)

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 Sub

Bonsoir 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 Sub

Cordialement.

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 Sub

Bonjour,

Merci beaucoup jean eric c'est exactement ce que je cherchais

Rechercher des sujets similaires à "copier onglet nouveau classeur vba"