Microsoft 365 Copier et coller dans une nouvelle feuille que les valeurs et non les formules

[Bob 31]

Bonjour à tous

J'ai besoin de l'aide
J'ai une macro ci dessous, mais je n'arrive pas à programmer dans ma formule de coller que les valeurs des données à coller
Avec cette macro ce colle les formules alors que je souhaite coller les valeurs dans la feuille créée.

En vous remerçiant par avance

Cordialement


Private Sub btnExtraction_click()

'Déclaration des variables
Dim MaRegion As Range
Dim ListeRegion As Range
Dim NbLignes As Long
Dim LigneActive As Long

'Affectation des variables
Set ListeRegion = Feuil1.Range("A2", Feuil1.Range("A1").End(xlDown))
NbLignes = ListeRegion.Rows.Count
LigneActive = 0

'On insère une nouvelle feuille
Sheets.Add
Feuil1.Range("A1").EntireRow.Copy ActiveCell
Range("A2").Select


'On boucle chaque Region se trouvant dans la liste
For Each MaRegion In ListeRegion

'On se décale d'une ligne vers le bas
LigneActive = LigneActive + 1

'On recherche le MOIS qui a été saisi dans la liste déroulante
If MaRegion.Offset(0, 0).Value = Me.ComboRegion.Value Then

'Si mon MOIS est trouvé on récupère l'enregistrement du mois
MaRegion.EntireRow.Copy ActiveCell
ActiveCell.Offset(1, 0).Select


End If
Next MaRegion

'Mise en forme des extractions
'On va ajuster les colonnes des tableaux
Range("A1").Select
ActiveCell.CurrentRegion.EntireColumn.AutoFit



End Sub

 

[mapomme]

Bonsoir @BOUBÉE, bienvenue sur XLD ,

Une autre méthode (surtout pour la suppression de lignes qui est une méthode assez utilisée et rapide en cas de nombreuses lignes). Je peux commenter si vous le désirez.
Il y a plus simple qui consisterait à utiliser un filtre sur Feuil1. Si vous êtes intéressé...
Il y a une autre méthode (proche de celle de Staple1600) mais qui perd le formatage.

Private Sub btnExtraction_click()
Dim valeurAfiltrer, Fdest As Worksheet, Colaux As Long
   If ComboRegion.ListIndex = -1 Then Exit Sub
   Application.ScreenUpdating = False
   valeurAfiltrer = ComboRegion
   On Error Resume Next
   Set Fdest = ThisWorkbook.Sheets(valeurAfiltrer)
   On Error GoTo 0
   If Fdest Is Nothing Then Set Fdest = ThisWorkbook.Worksheets.Add
   Fdest.Cells.Delete: Fdest.Name = valeurAfiltrer
   With Fdest
      .Select: ActiveWindow.Zoom = 70
      If Feuil1.FilterMode Then Feuil1.ShowAllData
      Feuil1.Range("a1").CurrentRegion.Copy
      .Range("a1").PasteSpecial xlPasteValues
      .Range("a1").PasteSpecial xlPasteFormats
      Colaux = Feuil1.Range("a1").CurrentRegion.Columns.Count + 1
      With .Range("a1").CurrentRegion.Resize(, Colaux)
         .Columns(Colaux).FormulaLocal = "=SI(A1=""" & valeurAfiltrer & """;LIGNE();NA())"
         .Cells(1, Colaux) = 0
         .Columns(Colaux) = .Columns(Colaux).Value
         .Sort key1:=.Cells(1, Colaux), order1:=xlAscending, Header:=xlYes
         On Error Resume Next
         .Columns(Colaux).SpecialCells(xlCellTypeConstants, xlErrors).EntireRow.Delete
         .Columns(Colaux).EntireColumn.Delete
         .Columns.AutoFit
      End With
   End With
End Sub

 

[mapomme]

Re,

La méthode v2 avec un filtre automatique.

Private Sub btnExtraction_click()
Dim valeurAfiltrer, Fdest As Worksheet, Colaux As Long
   If ComboRegion.ListIndex = -1 Then Exit Sub
   Application.ScreenUpdating = False
   valeurAfiltrer = ComboRegion
   On Error Resume Next
   Set Fdest = ThisWorkbook.Sheets(valeurAfiltrer)
   On Error GoTo 0
   If Fdest Is Nothing Then Set Fdest = ThisWorkbook.Worksheets.Add
   Fdest.Cells.Delete: Fdest.Name = valeurAfiltrer
   With Feuil1
      If .FilterMode Then .ShowAllData
      .Range("a1").CurrentRegion.AutoFilter Field:=1, Criteria1:=valeurAfiltrer
      .Range("a1").CurrentRegion.Copy Fdest.Range("a1")
   End With
   Fdest.Select: ActiveWindow.Zoom = 70
   Fdest.Range("a1").CurrentRegion.Columns.AutoFit
   If Feuil1.FilterMode Then Feuil1.ShowAllData
   Application.ScreenUpdating = True
End Sub

 

[Staple1600]

Bonjour le fil

Tu peux ne passer pas passer par une boucle
Et tu peux aussi ne pas passer par le copier/coller.

 

[Bob 31]

Si je penses ne pouvoir pas faire autrement

 

[Staple1600]

Re

Si, si on peut faire autrement
Voici comment

Sub Recopier()
Dim A_Copier
A_Copier = Range(Feuil1.[A2], Feuil1.Cells(Rows.Count, 1).End(3)).Value
Sheets.Add
Cells(1).Resize(UBound(A_Copier, 1), UBound(A_Copier, 2)) = A_Copier
End Sub

J'ai recopie les valeurs (et pas les formules) de la feuille Feuil1 sur une nouvelle feuille.
Et ce sans passer par une boucle, et sans faire Copier/Coller -> Valeurs seules

 

[Bob 31]

J'ai toujours le même problème, le coller est la formue du copier

 

[Staple1600]

Re

Tu as testé le code du message#4 tel quel?
Car je te certifie que les formules ne sont pas recopiées.

 

[Bob 31]

Comment tu réécris la formule complète avec l'ajout

 

[Staple1600]

Re

Fais ce test sur un classeur vierge (qui contient une seule feuille nommée Feuil1)
1) Lances la macro Préparer_Test
Tu vois alors des formules dans la colonne A de la feuille Feuil1
2) Lances alors la macro Recopier
Cela créé une nouvelle feuille, où tu verras que tu as bien en colonne A que les valeurs, sans les formules et même sans les formats

Sub Préparer_Test()
Feuil1.[A1] = "Test"
Feuil1.[A2:A33] = "=ROW()-1&""_""&ADDRESS(ROW(),COLUMN(),4)"
Feuil1.[A1].CurrentRegion.Borders.Weight = 2
Feuil1.[A1].CurrentRegion.Interior.ColorIndex = 6
End Sub

Sub Recopier()
Dim A_Copier
A_Copier = Range(Feuil1.[A2], Feuil1.Cells(Rows.Count, 1).End(3)).Value
Sheets.Add
Cells(1).Resize(UBound(A_Copier, 1), UBound(A_Copier, 2)) = A_Copier
End Sub

NB: Ceci n'est que du code VBA pour faire un test (pour vérifier que le code proposé fonctionne)

 

[Bob 31]

Cela ne peut fonctionner avec mon tableau
En effet j'ai un tableau avec 30 colonnes et 900 lignes et je souhaite créer des nouvelles feuilles (une par mois) Par exemple : quand sur une cellule de la ligne est indiqué un mois alors je recopie la ligne sur une nouvelle feuille pour le mois concerne (si janvier alors je copie la ligne complète sur une feuille nommée janvier)

 

[Staple1600]

Re

=>BOUBEE
Joins un fichier exemple anonymisé, on y verra plus clair
Et ce sera plus facile pour t'aider.

 

[Staple1600]

Re

Merci pour le fichier.
Je suppose que tu souhaites conserver la structure de ton classeur?
Et que qu'une autre piste (TCD par exemple) n'est pas envisageable ?

 

[Bob 31]

Oui je souhaite garder la structure de mon fichier (j'ai remplacé le mot MOIS par Region dans ma formule)
Je ne connais pas TCD je suis débutant et je trouvais sympa la possibilité d'extraire avec le bouton vers une nouvelle feuille une par mois

 

[Staple1600]

Re

Justement; si tu débutes, alors le TCD est fait pour toi.
Je te fais un petit exemple et je reviens.