Microsoft 365 Macro VBA pour copier des feuilles particulières

[driss Kor]

Bonjour,

Je travail sur un fichier excel et je voudrais par vba créer une copie des deux feuilles "Acceuil et Détail" sur un nouveau classeur et remplacer les formules par leur valeur sur ces nouvelles feuilles avant de l'envoyer
Plage de formule a remplacer par leur valeur [ feuille Acceuil C8:J13 ], [ feuille détail C6:I38 ].

Si quelqu'un peut m'aider ça serai génial.

 

[job75]

Bonjour le forum,

Je constate chez moi une chose.

S'il y a des tableaux structurés après copie des valeurs du UsedRange ils ne sont plus structurés ni filtrés.

Est-ce gênant ? Je ne sais pas.

A+

 

[job75]

La méthode Copy/PasteSpecial indiquée par wDog66 prend plus de temps.

Avec Application.ScreenUpdating = False => 18 millièmes de secondes pour chaque feuille Accueil et Détail.

Contre 0,13 millième pour la feuille Accueil et 0,4 millième de seconde pour la feuille Détail avec la copie du UsedRange.

S'il y a peu de feuilles à traiter ça n'a pas d'importance.

 

[job75]

Les 2 méthodes proposées ne vont pas si le tableau de la feuille Détail (non structuré) est filtré :

- avec la copie du UsedRange toutes les formules ne sont pas supprimées

- avec .Copy/PasteSpecial il y a bug.

Finalement le code le mieux adapté pour supprimer les formules est le suivant :

Dim w As Worksheet, c As Range
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next 'si aucune SpecialCell
'---'
For Each w In .Worksheets
    For Each c In w.Cells.SpecialCells(xlCellTypeFormulas)
        c = c.Value 'supprime la formule
Next c, w

Sur la feuille Détail (66 formules) la boucle c s'exécute en 5,7 millièmes de seconde.

 

[wDog66]

Les 2 méthodes proposées ne vont pas si le tableau de la feuille Détail (non structuré) est filtré :

- avec la copie du UsedRange toutes les formules ne sont pas supprimées

- avec .Copy/PasteSpecial il y a bug.

Finalement le code le mieux adapté pour supprimer les formules est le suivant :

Dim w As Worksheet, c As Range
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next 'si aucune SpecialCell
'---'
For Each w In .Worksheets
    For Each c In w.Cells.SpecialCells(xlCellTypeFormulas)
        c = c.Value 'supprime la formule
Next c, w

Sur la feuille Détail (66 formules) la boucle c s'exécute en 5,7 millièmes de seconde.

Feuille avec filtre actif, un détail effectivement qui peut avoir son importance

Donc je persiste et signe 😉

Sub Copier()
  Dim w As Worksheet
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  Sheets(Array("Accueil", "Détail")).Copy 'nouveau document
  With ActiveWorkbook
    For Each w In .Worksheets
      w.Activate
      On Error Resume Next
      w.ShowAllData
      On Error GoTo 0
      w.Cells.Copy
      w.Cells.PasteSpecial xlPasteValues
    Next
   .SaveAs ThisWorkbook.Path & "\Copie.xlsx", FileFormat:=51 'enregistrement
  .Close False
  End With
  Application.ScreenUpdating = True
  Application.DisplayAlerts = True
End Sub

A+

 

[job75]

Attention, .ShowAllData ne va pas si le tableau est structuré.

 

[job75]

Bon voici une solution qui fonctionne dans tous les cas de figure, tableaux structurés ou non, filtrés ou non :

Sub Copier()
Dim w As Worksheet, LO As ListObject, a As Range
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Sheets(Array("Accueil", "Détail")).Copy 'nouveau document
With ActiveWorkbook
    For Each w In .Worksheets
        On Error GoTo 0
        For Each LO In w.ListObjects 'tableaux structurés
            LO.Range.AutoFilter: LO.Range.AutoFilter 'ôte le filtre s'il existe
            w.Range(LO.Name) = w.Range(LO.Name).Value 'supprime les formules
        Next LO
        On Error Resume Next 'si aucune SpecialCell
        w.ShowAllData 'si tableau non structuré filtré
        For Each a In w.Cells.SpecialCells(xlCellTypeFormulas).Areas
            a = a.Value 'supprime les formules
    Next a, w
    .SaveAs ThisWorkbook.Path & "\Copie.xlsx", FileFormat:=51 'enregistrement
    .Close False
End With
End Sub

La macro travaille sur des plages (Areas) c'est plus rapide.

Il n'est plus question du UsedRange.

 

[driss Kor]

Merci Job75 pour ton support très apprécie.