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

 

[Bob 31]

Merci beaucoup pour le tableau croisé
Mais c'est vrai que pour mon expérience et pour mon apprentissage j'aurai aimé comprendre comment modifier ma formule et voir ou je me suis trompé et ou je bloque

 

[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

 

[Staple1600]

Bonjour mapomme

[aparté]
ColAux plutôt que ColOs_Copie, tu as eu raison
[/aparté]
Je pense que tu peux commenter pour le padawan BOUBEE
[/aparté]
Bonne galette des rois

 

[mapomme]

e pense que tu peux commenter pour le padawan BOUBEE

Tu as raison. On va s'y mettre...

 

[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]

Re

Voici ma participation
'Déclarations des variables

'Figer le rafraichissement écran

 

[mapomme]

Re,

La troisième méthode avec un tableau en mémoire (très rapide). Elle ne conserve pas le formatage (sauf la première ligne).

Private Sub btnExtraction_click()
Dim valeurAfiltrer, Fdest As Worksheet, tablo, Nlig As Long, i As Long, j 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
      tablo = .Range("a1").CurrentRegion.Value
   End With
   Nlig = 1
   For i = 2 To UBound(tablo)
      If tablo(i, 1) = valeurAfiltrer Then
         Nlig = Nlig + 1
         For j = 1 To UBound(tablo, 2)
            tablo(Nlig, j) = tablo(i, j)
         Next j
      End If
   Next i
   With Fdest
      .Select: ActiveWindow.Zoom = 70
      .Range("a1").Resize(Nlig, UBound(tablo, 2)) = tablo
      Feuil1.Rows(1).Copy .Rows(1)
      .Range("a1").CurrentRegion.Columns.AutoFit
   End With
   Application.ScreenUpdating = True
End Sub

 

[mapomme]

Re,

Si vous le demandez, je commenterai les codes...

 

[Bob 31]

Super
Je te remercie Mapomme et staple 1600
J'apprend et je me rends compte des progrès que j'ai a accomplir
Merci encore
Bonne soirée

 

[Bob 31]

Re,

Si vous le demandez, je commenterai les codes...

Bonjour merci encore pour la formule
Si je souhaite coller les formules de la feuille 1 et non plus les valeurs (comme avec la V2 ci dessous) quand j'extrais dans les onglets des mois (afin que ci je modifie une données de la formule de départ les modifications suivent quand c'est déjà extrait) est-ce possible avec cette méthode.
Merci

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

 

[Bob 31]

J'y suis arrivé avec la première formule VB
en changeant dans la formule :
.Range("a1").PasteSpecial xlPasteValues
par
.Range("a1").PasteSpecial xlPasteFormulas
Merci