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

Bob 31 · 9 Janvier 2021

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 · 9 Janvier 2021

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 · 9 Janvier 2021

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.

VB:

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 · 9 Janvier 2021

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 · 9 Janvier 2021

Staple1600 à dit:
e pense que tu peux commenter pour le padawan BOUBEE

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

mapomme · 9 Janvier 2021

Re,

La méthode v2 avec un filtre automatique.

Code:

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 · 9 Janvier 2021

Re

Voici ma participation
'Déclarations des variables

'Figer le rafraichissement écran

mapomme · 9 Janvier 2021

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).

VB:

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 · 9 Janvier 2021

Re,

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

Bob 31 · 9 Janvier 2021

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 · 11 Janvier 2021

mapomme à dit:
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 · 11 Janvier 2021

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

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

Bob 31

XLDnaute Occasionnel

Bob 31

XLDnaute Occasionnel

mapomme

XLDnaute Barbatruc

Pièces jointes

Staple1600

XLDnaute Barbatruc

mapomme

XLDnaute Barbatruc

mapomme

XLDnaute Barbatruc

Pièces jointes

Staple1600

XLDnaute Barbatruc

mapomme

XLDnaute Barbatruc

Pièces jointes

mapomme

XLDnaute Barbatruc

Bob 31

XLDnaute Occasionnel

Bob 31

XLDnaute Occasionnel

Bob 31

XLDnaute Occasionnel

Discussions similaires