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

JHA à dit:

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

Cliquez pour agrandir...

manzol à dit:

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.

Cliquez pour agrandir...

soan à dit:

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

Cliquez pour agrandir...

soan à dit:

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

Cliquez pour agrandir...