XL 2016 Copier coller dans nouveau classeur

KTM

XLDnaute Impliqué
Bonjour chers tous
Je voudrais depuis mon classeur actif
- copier ma plage A3:M45
-Créer un nouveau classeur
-et Coller dans ce classeur les valeurs en conservant les mises en forme sources.
Merci et excellente journée.
 

kiki29

XLDnaute Barbatruc
Salut, à lire et pratiquer : Excel et l'enregistreur de macro puis optimiser à la main

via le Macro Recorder tu devrais aboutir à ceci

VB:
Option Explicit

Sub MacroRecorder()
    Range("A3:M45").Select
    Selection.Copy
    Workbooks.Add
    Range("A3").Select
    ActiveSheet.Paste
    Range("A1").Select
    Application.CutCopyMode = False
    ChDir "C:\Test"
    ActiveWorkbook.SaveAs Filename:= _
        "C:\Test\Classeur1.xlsb" _
        , FileFormat:=xlExcel12, CreateBackup:=False
    ActiveWindow.Close
    Range("A1").Select
End Sub
 
Dernière édition:

KTM

XLDnaute Impliqué
Salut, à lire et pratiquer : Excel et l'enregistreur de macro puis optimiser à la main

via le Macro Recorder tu devrais aboutir à ceci

VB:
Option Explicit

Sub MacroRecorder()
    Range("A3:M45").Select
    Selection.Copy
    Workbooks.Add
    Range("A3").Select
    ActiveSheet.Paste
    Range("A1").Select
    Application.CutCopyMode = False
    ChDir "C:\Test"
    ActiveWorkbook.SaveAs Filename:= _
        "C:\Test\Classeur1.xlsb" _
        , FileFormat:=xlExcel12, CreateBackup:=False
    ActiveWindow.Close
    Range("A1").Select
End Sub
Super mais comment coller seulement les valeurs ? Merci
 

KTM

XLDnaute Impliqué
Salut, à lire et pratiquer : Excel et l'enregistreur de macro puis optimiser à la main

via le Macro Recorder tu devrais aboutir à ceci

VB:
Option Explicit

Sub MacroRecorder()
    Range("A3:M45").Select
    Selection.Copy
    Workbooks.Add
    Range("A3").Select
    ActiveSheet.Paste
    Range("A1").Select
    Application.CutCopyMode = False
    ChDir "C:\Test"
    ActiveWorkbook.SaveAs Filename:= _
        "C:\Test\Classeur1.xlsb" _
        , FileFormat:=xlExcel12, CreateBackup:=False
    ActiveWindow.Close
    Range("A1").Select
End Sub
Merci
J'ai adapté comme suit pour coller Valeurs et format mais il se trouve que les formules sont restées.
VB:
Sub Copie()
Application.ScreenUpdating = False
Dim chemin, fichier
    chemin = ThisWorkbook.Path & "\Dossier\"
    If Dir(chemin, vbDirectory) = "" Then MkDir chemin
    fichier = "test"
    Range("A1:C9").Copy
    Workbooks.Add
   ActiveSheet.[A1].Select
     With Selection
    .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    .PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    End With
                     Application.ScreenUpdating = False
                     Application.DisplayAlerts = False
    With ActiveWorkbook
    .SaveAs chemin & fichier, 51
    .Close
    End With
End Sub/CODE]
 

Pièces jointes

  • Source.xlsm
    18.6 KB · Affichages: 16

kiki29

XLDnaute Barbatruc
Salut,
VB:
Option Explicit

Sub CopierCollerSauver()
Dim WkbDepart As Workbook, WkbDestination As Workbook
Dim Wsh As Worksheet, sNomFichierDestination As String

    Application.ScreenUpdating = False

    Set WkbDepart = ThisWorkbook
    Set WkbDestination = Workbooks.Add

    Set Wsh = WkbDestination.Worksheets(1)
    Wsh.Name = "Destination"

    WkbDepart.Worksheets(Feuil1.Name).Range("A3:M45").Copy
    With WkbDestination
        .Worksheets(Wsh.Name).Range("A3").PasteSpecial Paste:=xlPasteValues    'xlPasteAll
        .Worksheets(Wsh.Name).Range("A3").PasteSpecial Paste:=xlPasteFormats
        .Worksheets(Wsh.Name).Range("A1").Select
    End With

    With Application
        .CutCopyMode = False
        .DisplayAlerts = False
    End With

    sNomFichierDestination = "Destination.xlsb"
    With WkbDestination
        .SaveAs Filename:=ThisWorkbook.Path & "\" & sNomFichierDestination, FileFormat:=xlExcel12
        .Close SaveChanges:=False
    End With

    With Application
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With

    WkbDepart.Worksheets(Feuil1.Name).Range("A1").Select

    Set Wsh = Nothing
    Set WkbDestination = Nothing
    Set WkbDepart = Nothing
End Sub
 
Dernière édition:

Discussions similaires

Réponses
6
Affichages
362

Statistiques des forums

Discussions
311 711
Messages
2 081 792
Membres
101 817
dernier inscrit
carvajal