XL 2016 importer les data d'un tableau dans un autre grâce au VBA

manzol

XLDnaute Nouveau
Bonjour à tous, je vous crois bien portant.
j'ai une préocupation (ci-joint mon fichier). j'ai un tableau dans la feuille 2, je veux que quand je clique sur actualiser, que ça recupère les éléments de la colonne C du tableau de la feuille1 puis il le recopie dans la première collone du tableau de la feuille2; après il recupère encore les éléments de la colonne D du tableau1 pour les recopier dans le tableau2 en commençant par la dernière lignes où les données s'etaient arrêtées. si possible que cela se copie selon l'ordre croissant car ce sont les numéros.
j'espère que vous me comprenez!

merci.
 

Pièces jointes

  • mon fichier mz2.xlsx
    15 KB · Affichages: 16
Solution
Bonjour manzol, JHA,

bon début de semaine à toi aussi. 🍀

ton fichier en retour ; clique sur le bouton Actualiser. 🙂

solution VBA pur jus, sans Power Query :

VB:
Option Explicit

Dim n1&, lg2&

Private Sub Job(col As Byte)
  Dim lg1&, i&
  With Worksheets("Feuil1")
    For i = 1 To n1
      lg1 = i + 5
      With .Cells(lg1, col)
        If .Value > 0 Then Cells(lg2, 1) = .Value: lg2 = lg2 + 1
      End With
    Next i
  End With
End Sub

Sub Essai()
  If ActiveSheet.Name <> "Feuil2" Then Exit Sub
  With Worksheets("Feuil1")
    n1 = .ListObjects("Tableau1").ListRows.Count
    If n1 = 0 Then Exit Sub 'y'a aucune donnée à copier
    Dim n2&: Application.ScreenUpdating = 0
    With...

JHA

XLDnaute Barbatruc
Bonjour à tous,

Pas sur de comprendre la demande, un essai avec power query, pour actualiser clic droit dans le tableau
A noter qu'il y avait des erreurs sur les dates en colonne "B"

JHA
 

Pièces jointes

  • mon fichier mz2.xlsx
    26.3 KB · Affichages: 5

manzol

XLDnaute Nouveau
Bonjour à tous,

Pas sur de comprendre la demande, un essai avec power query, pour actualiser clic droit dans le tableau
A noter qu'il y avait des erreurs sur les dates en colonne "B"

JHA
Merci JHA pour la solution, ça rapproche à ce que je veux. seulement power query je ne maitrise pas encore. d'où je penses macro serait une meilleur solution pour moi, car en un clic j'aurai le resultat.
et aussi il faut signaler que ce tableau c'est juste un echantillon car le tableau aura autant de lignes indefini.
 

manzol

XLDnaute Nouveau
Bonjour à tous, je vous crois bien portant.
j'ai une préocupation (ci-joint mon fichier). j'ai un tableau dans la feuille 2, je veux que quand je clique sur actualiser, que ça recupère les éléments de la colonne C du tableau de la feuille1 puis il le recopie dans la première collone du tableau de la feuille2; après il recupère encore les éléments de la colonne D du tableau1 pour les recopier dans le tableau2 en commençant par la dernière lignes où les données s'etaient arrêtées. si possible que cela se copie selon l'ordre croissant car ce sont les numéros.
j'espère que vous me comprenez!

merci.
Bon début de semaine à tous.
je suis toujours en attente d'autres propositions du forum.
merci d'avance
 

soan

XLDnaute Barbatruc
Inactif
Bonjour manzol, JHA,

bon début de semaine à toi aussi. 🍀

ton fichier en retour ; clique sur le bouton Actualiser. 🙂

solution VBA pur jus, sans Power Query :

VB:
Option Explicit

Dim n1&, lg2&

Private Sub Job(col As Byte)
  Dim lg1&, i&
  With Worksheets("Feuil1")
    For i = 1 To n1
      lg1 = i + 5
      With .Cells(lg1, col)
        If .Value > 0 Then Cells(lg2, 1) = .Value: lg2 = lg2 + 1
      End With
    Next i
  End With
End Sub

Sub Essai()
  If ActiveSheet.Name <> "Feuil2" Then Exit Sub
  With Worksheets("Feuil1")
    n1 = .ListObjects("Tableau1").ListRows.Count
    If n1 = 0 Then Exit Sub 'y'a aucune donnée à copier
    Dim n2&: Application.ScreenUpdating = 0
    With ActiveSheet.ListObjects("Tableau2")
      If Not IsEmpty(.DataBodyRange) Then n2 = .ListRows.Count
      lg2 = n2 + 4: Job 3: Job 4
      With .Sort.SortFields
        .Clear: .Add Key:=Range("Tableau2[[#All],[Comptes]]"), _
          SortOn:=xlSortOnValues, Order:=xlAscending
        .Parent.Apply
      End With
    End With
  End With
  ActiveCell.Select
End Sub

à te lire pour avoir ton avis. ;)

soan
 

Pièces jointes

  • mon fichier mz2.xlsm
    25 KB · Affichages: 8

manzol

XLDnaute Nouveau
Bonjour manzol, JHA,

bon début de semaine à toi aussi. 🍀

ton fichier en retour ; clique sur le bouton Actualiser. 🙂

solution VBA pur jus, sans Power Query :

VB:
Option Explicit

Dim n1&, lg2&

Private Sub Job(col As Byte)
  Dim lg1&, i&
  With Worksheets("Feuil1")
    For i = 1 To n1
      lg1 = i + 5
      With .Cells(lg1, col)
        If .Value > 0 Then Cells(lg2, 1) = .Value: lg2 = lg2 + 1
      End With
    Next i
  End With
End Sub

Sub Essai()
  If ActiveSheet.Name <> "Feuil2" Then Exit Sub
  With Worksheets("Feuil1")
    n1 = .ListObjects("Tableau1").ListRows.Count
    If n1 = 0 Then Exit Sub 'y'a aucune donnée à copier
    Dim n2&: Application.ScreenUpdating = 0
    With ActiveSheet.ListObjects("Tableau2")
      If Not IsEmpty(.DataBodyRange) Then n2 = .ListRows.Count
      lg2 = n2 + 4: Job 3: Job 4
      With .Sort.SortFields
        .Clear: .Add Key:=Range("Tableau2[[#All],[Comptes]]"), _
          SortOn:=xlSortOnValues, Order:=xlAscending
        .Parent.Apply
      End With
    End With
  End With
  ActiveCell.Select
End Sub

à te lire pour avoir ton avis. ;)

soan
merci beaucoup cher @soan. c'est exactement ce que je voulais. be blessed
merci aussi JHA, je vais apprendre power query pour ne plus être en retard
 

manzol

XLDnaute Nouveau
Bonjour manzol, JHA,

bon début de semaine à toi aussi. 🍀

ton fichier en retour ; clique sur le bouton Actualiser. 🙂

solution VBA pur jus, sans Power Query :

VB:
Option Explicit

Dim n1&, lg2&

Private Sub Job(col As Byte)
  Dim lg1&, i&
  With Worksheets("Feuil1")
    For i = 1 To n1
      lg1 = i + 5
      With .Cells(lg1, col)
        If .Value > 0 Then Cells(lg2, 1) = .Value: lg2 = lg2 + 1
      End With
    Next i
  End With
End Sub

Sub Essai()
  If ActiveSheet.Name <> "Feuil2" Then Exit Sub
  With Worksheets("Feuil1")
    n1 = .ListObjects("Tableau1").ListRows.Count
    If n1 = 0 Then Exit Sub 'y'a aucune donnée à copier
    Dim n2&: Application.ScreenUpdating = 0
    With ActiveSheet.ListObjects("Tableau2")
      If Not IsEmpty(.DataBodyRange) Then n2 = .ListRows.Count
      lg2 = n2 + 4: Job 3: Job 4
      With .Sort.SortFields
        .Clear: .Add Key:=Range("Tableau2[[#All],[Comptes]]"), _
          SortOn:=xlSortOnValues, Order:=xlAscending
        .Parent.Apply
      End With
    End With
  End With
  ActiveCell.Select
End Sub

à te lire pour avoir ton avis. ;)

soan
merci beaucoup cher @soan. c'est exactement ce que je voulais. be blessed
merci aussi @JHA, je vais apprendre power query pour ne plus être en retard
 

Discussions similaires

Statistiques des forums

Discussions
311 723
Messages
2 081 934
Membres
101 844
dernier inscrit
pktla