Microsoft 365 VBA : copier 2 onglets

[VBA_dev_Anne_Marie]

Bonjour,

Voici mon code pour copier 2 onglets en valeurs dans un nouveau fichier, mais les lignes

.Sheets(1).UsedRange.Value = .Sheets(1).UsedRange.Value
.Sheets(2).UsedRange.Value = .Sheets(1).UsedRange.Value ne copient pas les données.

Pourriez vous me conseiller comment on peut coller les données en valeur ?

  With ThisWorkbook
    .Sheets(Array("Suivi 1", "Suivi 2")).Copy
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs .Path & "\" & NomFichier
    Application.DisplayAlerts = True
    .Sheets(1).UsedRange.Value = .Sheets(1).UsedRange.Value
    .Sheets(2).UsedRange.Value = .Sheets(1).UsedRange.Value
    ActiveWorkbook.Close
   End With

Merci beaucoup pour votre aide !

 

[job75]

Bonsoir Anne-Marie,

Vous n'avez pas bien compris ce fil :

https://excel-downloads.com/threads...euilles-particulieres.20087086/#post-20687422

Donc utilisez :

Sub Copie()
Dim NomFichier$
NomFichier = "Copie.xlsx"
Application.ScreenUpdating = False
Application.DisplayAlerts = False
ThisWorkbook.Sheets(Array("Suivi 1", "Suivi 2")).Copy
With ActiveWorkbook
    .Sheets(1).UsedRange = .Sheets(1).UsedRange.Value
    .Sheets(2).UsedRange = .Sheets(2).UsedRange.Value
    .SaveAs ThisWorkbook.Path & "\" & NomFichier, 51
    .Close False
End With
End Sub

A+

 

[VBA_dev_Anne_Marie]

Bonsoir Anne-Marie,

Vous n'avez pas bien compris ce fil :

https://excel-downloads.com/threads...euilles-particulieres.20087086/#post-20687422

Donc utilisez :

Sub Copie()
Dim NomFichier$
NomFichier = "Copie.xlsx"
Application.ScreenUpdating = False
Application.DisplayAlerts = False
ThisWorkbook.Sheets(Array("Suivi 1", "Suivi 2")).Copy
With ActiveWorkbook
    .Sheets(1).UsedRange = .Sheets(1).UsedRange.Value
    .Sheets(2).UsedRange = .Sheets(2).UsedRange.Value
    .SaveAs ThisWorkbook.Path & "\" & NomFichier, 51
    .Close False
End With
End Sub

A+

Merci, ça marche très bien ! Est-ce que vous connaissez une option à ajouter qui permet juste de rompre les liaisons ?

 

[job75]

Bonsoir,

Pour tenir compte de ce qu'on a découvert sur ce fil :

https://excel-downloads.com/threads...euilles-particulieres.20087086/#post-20687622

Utilisez plutôt :

Sub Copie()
Dim NomFichier$
NomFichier = "Copie.xlsx"
Application.ScreenUpdating = False
Application.DisplayAlerts = False
ThisWorkbook.Sheets(Array("Suivi 1", "Suivi 2")).Copy
With ActiveWorkbook
    With .Sheets(1).UsedRange: .Value = .Value: End With
    With .Sheets(2).UsedRange: .Value = .Value: End With
    .SaveAs ThisWorkbook.Path & "\" & NomFichier, 51
    .Close False
End With
End Sub

A+

 

[job75]

Bonjour Anne-Marie,

Avec la dernière solution de ce fil :

https://excel-downloads.com/threads...s-particulieres.20087086/page-2#post-20687744

Sub Copie()
Dim NomFichier$, w As Worksheet, LO As ListObject, a As Range
NomFichier = "Copie.xlsx"
Application.ScreenUpdating = False
Application.DisplayAlerts = False
ThisWorkbook.Sheets(Array("Suivi 1", "Suivi 2")).Copy
With ActiveWorkbook
    For Each w In .Sheets(Array("Suivi 1", "Suivi 2"))
        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 & "\" & NomFichier, 51
    .Close False
End With
End Sub

A+