XL 2016 Résolu - Copier coller feuilles nouveau classeur

[aragdur]

Hello
Je souhaiterai faire un copier coller des feuilles du classeur 1 vers un nouveau classeur.
Conditions :
- classeur 1 a un nombre de feuilles aléatoires.
- le copier coller doit inclure la mise en forme et les valeurs sans les formules.
Y a également des graphiques sur le fichier.

J étais initialement parti sur :

Sub copy
Dim A(), i
ReDim A (1 To Sheets.count)
For i = 1 To Sheets.Count:A(i) = i: Next
Sheets(A).Copy
End Sub

Je pensais ensuite inclure un paste spécial.
Mais ça foire.
Merci de votre aide

 

[Robert]

Bonsoir Aragdur, bonsoir le forum,

Peut-être comme ça :

Sub copy()
Dim I As Integer 'déclare la variable I (Incrément)
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)

Application.ScreenUpdating = False 'masque les rafraîchissement d'écran
Set CS = ThisWorkbook 'définit le classeur source CS
For I = 1 To CS.Sheets.Count 'boucle sur tous les onglets I du classeur source
    Select Case I 'agit en fonction de I
        Case 1 'cas 1
            CS.Sheets(I).copy 'copie l'onglet de la boucle dans un fichier vierge
            Set CD = ActiveWorkbook 'définit la classeur destination CD
        Case Else 'tous les autres cas
            CS.Sheets(I).copy After:=CD.Sheets(Sheets.Count) 'copy l'onglet de la boucle en dernière position
    End Select 'fin de l'action en fonction de I
    ActiveSheet.Cells.copy 'copie toutes les cellule de l'onglet actif
    ActiveSheet.Range("A1").PasteSpecial (xlPasteValues) 'colle les valeurs
    ActiveSheet.Range("A1").Select 'sélectionne A1 de l'onglet Actif
    Application.CutCopyMode = False 'annule le clignotement lié au copier
Next I 'prochain onglet de la boucle
CD.Sheets(1).Activate 'active le premier onglet du classeur destination
Application.ScreenUpdating = True 'affiche les rafraîchissement d'écran
End Sub

 

[aragdur]

Bonsoir Aragdur, bonsoir le forum,

Peut-être comme ça :

Sub copy()
Dim I As Integer 'déclare la variable I (Incrément)
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)

Application.ScreenUpdating = False 'masque les rafraîchissement d'écran
Set CS = ThisWorkbook 'définit le classeur source CS
For I = 1 To CS.Sheets.Count 'boucle sur tous les onglets I du classeur source
    Select Case I 'agit en fonction de I
        Case 1 'cas 1
            CS.Sheets(I).copy 'copie l'onglet de la boucle dans un fichier vierge
            Set CD = ActiveWorkbook 'définit la classeur destination CD
        Case Else 'tous les autres cas
            CS.Sheets(I).copy After:=CD.Sheets(Sheets.Count) 'copy l'onglet de la boucle en dernière position
    End Select 'fin de l'action en fonction de I
    ActiveSheet.Cells.copy 'copie toutes les cellule de l'onglet actif
    ActiveSheet.Range("A1").PasteSpecial (xlPasteValues) 'colle les valeurs
    ActiveSheet.Range("A1").Select 'sélectionne A1 de l'onglet Actif
    Application.CutCopyMode = False 'annule le clignotement lié au copier
Next I 'prochain onglet de la boucle
CD.Sheets(1).Activate 'active le premier onglet du classeur destination
Application.ScreenUpdating = True 'affiche les rafraîchissement d'écran
End Sub

C est parfait.

Un grand merci