Sélection d'une plage variable répondant à une condition, pour copie.

webmuster

XLDnaute Junior
Bonjour à toutes et à tous

Après des jours de recherches personnelles, je me résous à solliciter votre aide.

Je vous joins un petit fichier fictif qui, je l'espère, vous éclairera tout de même sur mon besoin.

J'ai, en A1, une liste de validation (des Mois).
De A3 à A10, des dates.
De B3 à D10, des valeurs.
Un bouton de commande

Je recherche, en fonction du mois choisi en A1, à sélectionner une plage contenant les dates répondant au critère, ainsi que les valeurs adjacentes, mon but final étant de copier, puis coller ces données dans un autre classeur.

Voici un code concocté grâce à votre communauté, mais avec lequel je rencontre un problème :
- la plage recherchée, bien qu'étant mise en surbrillance, n'est pas vraiment sélectionnée, d'où mon incapacité à la copier pour collage.


Sub export()

Dim c As Range
For Each c In Range("A3:A10")
If c.Value <> "" Then
If Month(c.Value) = Month(Range("A1").Value) Then
Application.Union(Selection, Range(c, c.Offset(0, 3))).Select
End If
End If
Next

End Sub

Pouvez-vous m'éclairer ?

Bien cordialement
 

Pièces jointes

  • suivi mensuel.xlsm
    17.7 KB · Affichages: 25
  • suivi mensuel.xlsm
    17.7 KB · Affichages: 30
  • suivi mensuel.xlsm
    17.7 KB · Affichages: 29

job75

XLDnaute Barbatruc
Re : Sélection d'une plage variable répondant à une condition, pour copie.

Re,

Nos posts se sont croisés.

C'est bien ce que je pensais, il faut un copier/coller intermédiaire pour supprimer les formules :

Code:
Sub export1()
Dim nomfich, nomfeuil, r As Range, mois As Byte, an, s As Range
'---préparation---
nomfich = "TOTO.xlsx" 'fichier destination, à adapter
nomfeuil = "MaFeuille" 'feuille destination, à adapter
With Feuil1 'CodeName de la feuille source
  Set r = .Range("A3:D" & .Range("A" & .Rows.Count).End(xlUp)(3).Row)
  If IsDate(.[A1]) Then
    mois = Month(.[A1])
    an = Year(.[A1])
  End If
End With
'---analyse---
For Each r In r.Rows
  If Month(r.Cells(1)) = mois And Year(r.Cells(1)) = an Then _
    Set s = Union(r, IIf(s Is Nothing, r, s))
Next
'---supprime les formules---
If Not s Is Nothing Then
  s.Copy s.Parent.[AA1] 'en dehors de la zone de travail
  Set s = s.Parent.[AA1].CurrentRegion.Resize(, s.Columns.Count)
  s = s.Value
End If
'---export---
On Error Resume Next 'si le fichier destination n'est pas ouvert
With Workbooks(nomfich).Sheets(nomfeuil)
  .Rows("2:" & .Rows.Count).Delete 'RAZ
  s.Copy .[A2]
  Application.Goto .[A1], True
End With
s.EntireColumn.Delete
End Sub
Edit : je vois que dans le tableau source il peut y avoir des cellules vides.

Pour éviter toute mauvaise surprise, il est bon de donner à la 2ème plage s la bonne largeur :

Code:
Set s = s.Parent.[AA1].CurrentRegion.Resize(, s.Columns.Count)
A+
 
Dernière édition:

Discussions similaires

Réponses
3
Affichages
204
Réponses
7
Affichages
322

Statistiques des forums

Discussions
312 206
Messages
2 086 219
Membres
103 158
dernier inscrit
laufin