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

Bob 31

XLDnaute Nouveau
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

XLDnaute Barbatruc
Supporter XLD
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
 

Pièces jointes

  • BOUBÉE-TABLEAU RECAP ANNUEL- v1.xlsm
    52.3 KB · Affichages: 2
Dernière édition:

mapomme

XLDnaute Barbatruc
Supporter XLD
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
 

Pièces jointes

  • BOUBÉE-TABLEAU RECAP ANNUEL- v2.xlsm
    52.7 KB · Affichages: 4

mapomme

XLDnaute Barbatruc
Supporter XLD
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
 

Pièces jointes

  • BOUBÉE-TABLEAU RECAP ANNUEL- v3.xlsm
    53.7 KB · Affichages: 3

Bob 31

XLDnaute Nouveau
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
 

Discussions similaires

Haut Bas