Extraire données d'un tableau en VBA

[Amilo]

Bonjour le forum,

Mes connaissances en VBA étant limitées, pouvez-vous svp m'aider dans mon problème ?

A partir de l'onglet "Source", je souhaite extraire des valeurs vers l'onglet "Synthèse",
Ces valeurs dépendent de la cellule A1 de l'onglet "Synthèse",

Je vous joins un fichier pour je l'espère une meilleure compréhension,

Cordialement

 

[Staple1600]

Re : Extraire données d'un tableau en VBA

Bonsoir à tous

Ceci semble faire l'affaire

Sub mAmilo_OK()
Dim c As Range, i&
i = 2
For Each c In Sheets("Source").Columns("E:F").SpecialCells(xlCellTypeConstants, 2)
If c = "A" Then
Select Case c.Column
Case 5
Sheets("Synthèse").Cells(i, "D").Value = c.Offset(, 1)
i = i + 1
Case 6
Sheets("Synthèse").Cells(i, "C").Value = c.Offset(, -1)
i = i + 1
End Select
End If
Next
End Sub

 

[Amilo]

Re : Extraire données d'un tableau en VBA

Bonjour Staple1600,

Merci beaucoup pour votre aide,
Le code fonctionne très bien sur une plage avec des cellules vides mais en réalité il n'y a aucune cellule vide,
Désolé, je l'avais précisé dans mon fichier mais pas dans mon message,
Par ailleurs, la cellule A1 comporte une liste déroulante dans la quelle je peux sélectionner le nom souhaité,
Je souhaiterai que la plage s'actualise automatique à la sélection du nom en A1,

Je vous joins un nouveau fichier se rapprochant de fichier réel,

Merci d'avance

Cordialement

 

[job75]

Re : Extraire données d'un tableau en VBA

Bonjour Amilo, Jean-Marie,

Fichier joint avec cette macro dans le code de la feuille "Synthèse" :

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [A1]) Is Nothing Then Exit Sub
Dim dest As Range, source As Range, s, r As Range
'---initialisation---
Set dest = [C2] '1ère cellule, à adapter
With Feuil1 'CodeName
  Set source = .[E:F] 'colonnes à adapter
  Set source = Intersect(source, .UsedRange.EntireRow)
End With
s = Target
'---copie---
Application.ScreenUpdating = False
source.Copy dest 'pour les formats
Set dest = dest.Resize(source.Rows.Count, source.Columns.Count)
dest = source.Value 'copie les valeurs
'---traitement des données---
For Each r In dest.Rows
  If Application.CountIf(r, s) = 0 Then r = "#N/A"
Next
On Error Resume Next 's'il n'y a pas de SpecialCells
dest.SpecialCells(xlCellTypeConstants, 16).Delete xlUp
dest.Replace s, "#N/A", xlWhole
dest.SpecialCells(xlCellTypeConstants, 16).Clear
End Sub

Elle se déclenche quand la cellule A1 est (re)validée.

Les formats et les valeurs sont copiées.

A+

 

[Amilo]

Re : Extraire données d'un tableau en VBA

Bonjour job75,

Je crois bien que nos messages se sont croisés, comme le code à Staple1600, votre code fonctionne très bien également sur le fichier tel que présenté,

J'ai joint un nouveau tableau dans mon précédent message, désolé j'aurais dû le compléter dès le départ,
Autre précision, il n'y a pas de lettres mais des noms en réalité,

Cordialement

 

[job75]

Re : Extraire données d'un tableau en VBA

Re,

Dans la feuille "Source" (fichier du post #4) j'ai recopié le tableau sur 2300 lignes.

Sur Win 8 - Excel 2013 la macro s'exécute en 1,3 seconde.

A+

 

[Amilo]

Re : Extraire données d'un tableau en VBA

job75,

Mille excuses, je me suis très mal pris pour mon fichier exemple, d'autant que je viens de constater que dans la précipitation j'ai commis une erreur dans mon autre fichier en post 3,

Celui-ci devrait être beaucoup plus clair,

Merci pour votre compréhension

Cordialement

 

[job75]

Re : Extraire données d'un tableau en VBA

Re,

On avait bien compris.

Dans ce fichier (2) la macro est beaucoup plus rapide :

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [A1]) Is Nothing Then Exit Sub
Dim dest As Range, source As Range, r As Range, h&
'---initialisation---
Set dest = [C2] '1ère cellule, à adapter
With Feuil1 'CodeName
  Set source = .[E:F] 'colonnes à adapter
  Set source = Intersect(source, .UsedRange.EntireRow)
End With
'---copie---
Application.ScreenUpdating = False
source.Copy dest 'pour les formats
Set dest = dest.Resize(source.Rows.Count, source.Columns.Count)
dest = source.Value 'copie les valeurs
'---traitement des données---
On Error Resume Next 's'il n'y a pas de SpecialCells
dest.Replace [A1], "#N/A", xlWhole
With dest.SpecialCells(xlCellTypeConstants, 16)
  .Clear
  With Intersect(.EntireRow, dest)
     h = Intersect(.Cells, dest.Columns(1)).Count
     .Copy dest(dest.Rows.Count + 1, 1) 'zone tampon sous le tableau
  End With
End With
dest.Offset(dest.Rows.Count).Resize(h).Copy dest(1)
dest.Offset(h).Resize(Rows.Count - h - dest.Row + 1).Delete xlUp
End Sub

Il n'y a plus de boucle.

Sur 2500 lignes dans la feuille "Source" la macro s'exécute en 0,13 seconde.

Bonne fin de soirée.

 

[Amilo]

Re : Extraire données d'un tableau en VBA

Re,

Magnifique job75 et mille mercis,
Cela fonctionne très bien,

Merci encore à Staple1600, je pense que vos précédents codes me serviront un jour dans d'autres cas,

Bonne nuit à vous

Cordialement

 

[job75]

Re : Extraire données d'un tableau en VBA

Re,

J'ai fait une petite modif à la fin sur cette ligne :

dest.Offset(dest.Rows.Count).Resize(h).Copy dest(1)

Edit : de plus la variable s était inutile, et même nuisible.

A+

 

[Amilo]

Re : Extraire données d'un tableau en VBA

Merci job75 pour cette info, j'en prends note

J'étais sur votre code afin d'essayer de le comprendre et l'adapter à mon fichier,
Normalement avec vos explications ça devrait aller...

Edit : voilà j'ai adapté le code à mon fichier, j'ai juste eu à modifier le nom des onglets et tout fonctionne parfaitement
Merci encore pour votre aide

Cordialement