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

[webmuster]

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

 

[job75]

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

Bonsoir webmuster,

Voici une manière de faire :

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
'---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]
End With
End Sub

Le fichier destination doit être ouvert.

Mettre les titres adéquats en ligne 1 de la feuille destination.

A+

 

[webmuster]

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

Merci job75

Je me penche sur ta solution et reviens vers toi.

Cordialement

 

[webmuster]

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

Merci job75

Après adaptation des noms de fichiers et feuilles, ton code fonctionne parfaitement.

Je me suis permis de modifier la ligne de déclaration comme suit :

Dim nomfich, nomfeuil, r As Range, mois As Byte, an, s As Range

J'espère que le code reste correct.

Encore merci pour ton aide

Bien cordialement

 

[job75]

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

Re,

Cela ne pose aucun problème, simplement cela déclare les variables nomfich, nomfeuil, an comme Variant.

Elles occupent plus de place en mémoire, mais l'exécution n'est pas ralentie.

A+

 

[webmuster]

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

Merci à toi

Bonne fin de soirée

Cordialement

 

[job75]

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

Bonjour webmuster, le forum,

Voici une solution qui utilise le filtre avancé (ou élaboré) :

Sub export2()
Dim ncol%, nomfich$, nomfeuil$, r As Range, mois As Byte, an%, mem
'---préparation---
ncol = 4 'nombre de colonnes du tableau source
nomfich = "TOTO.xlsx" 'fichier destination, à adapter
nomfeuil = "MaFeuille" 'feuille destination, à adapter
With Feuil1 'CodeName de la feuille source
  Set r = .Range("A2", .Range("A" & .Rows.Count).End(xlUp)(3)).Resize(, ncol)
  If IsDate(.[A1]) Then
    mois = Month(.[A1])
    an = Year(.[A1])
  End If
End With
'---filtre avancé---
mem = r(1).Resize(2, ncol + 1).Formula 'mémorisation
r(1) = 1: r(1).Resize(, ncol + 1).DataSeries 'il faut des en-têtes
r(2, ncol + 1) = "=AND(MONTH(A3)=" & mois & ",YEAR(A3)=" & an & ")" 'critère
On Error Resume Next 'si le fichier destination n'est pas ouvert
With Workbooks(nomfich).Sheets(nomfeuil)
  .Rows("2:" & .Rows.Count).Delete 'RAZ
  r.AdvancedFilter xlFilterCopy, r(1, ncol + 1).Resize(2), .[A2]
  .Rows(2).Delete
  Application.Goto .[A1], True
End With
r(1).Resize(2, ncol + 1) = mem 'restitution
End Sub

L'exécution est plus rapide sur un grand tableau.

A+

 

[job75]

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

Re,

Tiens au passage je découvre un phénomène que je ne connaissais pas.

Le formatage "gras" des cellules B2 C2 D2 du tableau source disparaît.

Mais il demeure si l'on met la cellule A2 (vide) en "gras"

Edit : j'ai compris, c'est dû à DataSeries qui tire aussi les formats, je ne savais pas ça.

A+

 

[webmuster]

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

Bonjour job75

J'aimerai ne copier que les valeurs et mises en forme, sans les formules.

Comment l'intégrer dans ton code :

s.Copy .[A2]

Cordialement

 

[job75]

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

Re,

J'aimerai ne copier que les valeurs et mises en forme, sans les formules.

Avec le filtre avancé du post #7 les formules ne sont pas copiées.

Avec la solution du post #2 les formules peuvent poser problème, il faudrait voir votre fichier.

Il faudra peut-être une étape intermédiaire : copier/coller s d'abord dans la feuille source.

A+

 

[webmuster]

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

Merci job75

Pour faire simple, disons qu'à terme, les valeurs, de B3 à D10, du fichier joint à mon message initial, seront le résultat de formules.

Comment ne copier dans le fichier "TOTO", que ces valeurs, et non les formules ?

Cordialement

 

[job75]

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

Re,

Je répète : il faut votre fichier pour voir la nature de ces formules.

A+

 

[webmuster]

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

Merci job75

Je joins mon petit fichier exemple, dans lequel j'ai ajouté les formules type en colonne D.

Bien cordialement

 

[job75]

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

Re,

S'il s'agit seulement de supprimer les formules de la feuille destination c'est très simple :

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
'---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]
  .UsedRange = .UsedRange.Value 'supprime les formules
  Application.Goto .[A1], True
End With
End Sub

Cela suppose que les résultats des formules sont corrects.

A+

 

[webmuster]

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

Merci job75

Je me permettrai de revenir vers toi si besoin.

Cordialement