VBA copier/coller tableau source vers tableau cible

LilouExcelNovice

XLDnaute Nouveau
Bonjour,

Je suis novice dans en VBA, j'ai tout de même réussi à faire un petit programme qui me permet de faire du filtre élaboré. Il me reste un problème à régler :
Le but => Faire remonter des informations d'un tableau source (sous forme tabulaire) vers un tableau cible (toujours sous forme tabulaire) selon des critères de sélection (d'où mon filtre élaboré).
Tout fonctionne parfaitement sauf si mon tableau cible n'a pas asses de ligne.
Je ne trouve pas dans mon VBA, ni quoi ni où mettre, une fonction qui ajouterai le nombre de lignes nécessaires

Voici mon VBA :

Sub GENERATION_SITUATION()
Sheets("Factures CLIENTS").Range("Tableau17[#All]").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sheets("Bilan Chantier").Range("O4:O5"), CopyToRange:=Range("Tableau68[[#Headers],[#Data]]"), Unique:=True
End Sub

Je suis sure que parmi tous les membres, il y a bien quelqu'un qui pourra m'aider :)
Par avance merci pour votre aide précieuse.
 

Staple1600

XLDnaute Barbatruc
Bonjour le fil, le forum

@LilouExcelNovice [Bienvenue sur le forum]
Si tu peux joindre un fichier Excel anonymisé, ce serait plus facile de t'aider.
Si non, je vais en profiter pour aller éplucher mes pommes pour mon gâteau de pain perdu aux pommes.
A toi de voir si tu me diriges vers ma cuisine ou si ton fichier à venir m'oblige à rester devant mon clavier ;)
 

Staple1600

XLDnaute Barbatruc
Re

T'as vraiment pas le temps de nous concocter un petit fichier exemple qui reprends la structure de tes deux tableaux mais avec des données bidons ?

[aparté]Zut j'ai mis du jaune d'oeuf sur mon clavier
Damned, j'ai plus de sucre vanillé!!
[/aparté]
 

LilouExcelNovice

XLDnaute Nouveau
Me revoilà avec un fichier qui va bien.

Donc dans l'onglet cible, je choisi le client pour lequel je souhaite faire remonter la liste des factures que je lui ai établi et en exécutant la macro, je souhaite que le tableau me sorte le nombre de lignes nécessaires, ni plus ni moins... s'il y en a plus avant d'exécuter la macro, pas de problème. En revanche s'il en manque, ça bug.

J'espère être claire dans mes explications, sinon n'hésites pas à revenir vers moi.

Merci beaucoup.

Comment va ton gâteau de pain perdu au pomme ??? :) miam miam
 

Pièces jointes

  • Aide Excel Download.xlsm
    86.3 KB · Affichages: 65

Staple1600

XLDnaute Barbatruc
Re

Je tâtonne mais on se rapproche, non ?
VB:
Sub GENERATION_SITUATION_v2()
Dim nl&, ln&, tabSrc As Excel.ListObject, tabDest As Excel.ListObject
Set tabSrc = Sheets("Source").ListObjects("Tableau2")
Set tabDest = Sheets("Cible").ListObjects("Tableau1")
tabSrc.Range.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Sheets("Cible").Range("D1:D2"), Unique:=True
nl = tabSrc.ListColumns(1).DataBodyRange.SpecialCells(12).Count
With tabDest
    ln = .DataBodyRange.Rows.Count
    .Resize .Range.Resize(.Range.Rows.Count + nl)
    tabSrc.DataBodyRange.SpecialCells(12).Copy
    .DataBodyRange.Cells(ln + 1, 1).PasteSpecial -4163
End With
End Sub

Le gâteau tiédit dans son moule ;)
 

Staple1600

XLDnaute Barbatruc
Re

Suite de mes tâtons
VB:
Sub GENERATION_SITUATION_v3()
Dim nl&, ln&, tabSrc As Excel.ListObject, tabDest As Excel.ListObject
Set tabSrc = Sheets("Source").ListObjects("Tableau2")
Set tabDest = Sheets("Cible").ListObjects("Tableau1")
tabSrc.Range.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Sheets("Cible").Range("D1:D2"), Unique:=True

With tabDest
If .DataBodyRange.Rows.Count <> tabSrc.DataBodyRange.Rows.Count Then
    .DataBodyRange.Cells.Clear
    .Resize .Range.Cells(1).Resize(tabSrc.HeaderRowRange.Rows.Count + tabSrc.DataBodyRange.Rows.Count, tabSrc.Range.Columns.Count)
End If
tabSrc.DataBodyRange.Copy Destination:=.DataBodyRange.Cells(1)
End With
End Sub
Si d'autres viendra, ça seront mieux car je patauge un chouia ;)
 

Staple1600

XLDnaute Barbatruc
Bonjour le fil, le forum

Pas mieux pour le moment
VB:
Sub DenierTatonDuDimancheMatinQuandLeCaféFumeEncore()
Dim NL As Long
NL = Sheets("Source").ListObjects("Tableau2").DataBodyRange.Rows.Count
Sheets("Cible").ListObjects("RESULTATS").Resize Range("$A$4:$S$" & NL)
Sheets("Source").ListObjects("Tableau2").Range.AdvancedFilter _
    Action:=xlFilterCopy, _
    CriteriaRange:=Sheets("Cible").Range("D1:D2"), _
    CopyToRange:=Range("RESULTATS[[#Headers],[#Data]]"), Unique:=True
End Sub
PS: Ne pas oublier de remettre Tableau1 à la place de RESULTATS partout dans le code.
 

Si...

XLDnaute Barbatruc
Bon_jour

Une de mes recettes* aux petits oignons avec ce que j'ai compris de la commande.

Dans la fenêtre de codes de l'onglet cible :
VB:
Private Sub Worksheet_Change(ByVal R As Range)
  If R.Address = [D2].Address Then
  If [Tableau1].Item(1, 1) <> "" Then [Tableau1].Delete
  If R = "" Then Exit Sub
  [Tableau2].AutoFilter 6, R
  With [Tableau2]
  Union(.Columns(1), .Columns(10), .Columns("N:O"), .Columns(17)).SpecialCells(12).Copy [Tableau1]
  End With
  [Tableau2].AutoFilter
  End If
End Sub

*j'ai du mal à digérer la tienne Staple
;)
 

Pièces jointes

  • Filtre Copie Colonnes.xlsm
    21.5 KB · Affichages: 70
Dernière édition:

Si...

XLDnaute Barbatruc
Re

Que de fois voit-on cette assertion (et même quand le demandeur fournit un classeur avec des macros dignes d'un pro) !
On en a fréquenté quelques-uns qui après des milliers de demandes n'ont pas progressé d'un pouce en VBA et même en Formules.

Je pars de l'idée suivante : la personne attend de nous une solution sans regarder sous le capot ou le lecteur veut des explications pour vraiment comprendre et apprendre.

Il y a des lecteurs qui sont tentés par les propositions, ne serait-ce que pour les adapter à leur projet.
Dans ce dernier cas, si elles sont demandées, je donne des explications.
Tu as dû remarquer que je n'étais pas avare dans ce domaine. Cela me prend, quelque fois, plus de temps que pour construire les macros.

Parfois je mets quelques lignes vertes dans le code, pas partout car cela peut devenir touffu.
Quand je vois du vert à chaque ligne d'une procédure qui n'en finit pas d'en finir, je vois rouge !
Je préfère expliquer dans un onglet qui offre la possibilité d'imprimer cela afin d'éviter des allers-retours incessants d'une fenêtre à une autre.

Voilà, c'est tout pour Toi Staple* !

Mais pas pour toi Lilou :) si tu veux savoir des commentaires du code (tu auras aussi la possibilité de rencontrer d'autres cuistots et même des Maîtres).

*oups, j'ai oublié de te dire que c'est le .Range.AdvancedFilter qui m'a interpelé (avant toi bien sûr ;))

 

LilouExcelNovice

XLDnaute Nouveau
Bonsoir à tous les deux,

Tout d'abord un grand merci pour votre temps investi.
Je suis plutôt du genre à regarder sous le capot ;), puis il va bien falloir car j'ai plusieurs tableaux à mettre à jour, donc le code va forcément être amené à être adapté à mon vrai projet.
Je vais donc éplucher vos réponses et je ne manquerai pas à revenir vers vous si besoin est, histoire de mettre un peux de vert dans ce code... mais je ne voudrais pas que si... vois rouge tout de même.

Bonne soirée à vous et peut être à tout à l'heure :)
 

Statistiques des forums

Discussions
311 733
Messages
2 082 010
Membres
101 866
dernier inscrit
XFPRO