Macro en "détresse" avec extension tableau

Bonjour tout le monde

Veuillez me donner un coup de main pour résoudre un problème que je n'arrive pas à résoudre par divers changements:

Il s'agit d'un tableau de 5 colonnes, dans feuilles "Solde"; la macro fait bien le travail pour l'extraction d'une partie dans l'autre feuille "Relevé

J'ai ajouter 2 colonnes dans le tableau et j'ai suivi la même logique(d'après moi) pour que la macro fait comme le 1er fichier mais ça coince.

(Je suis débutant dans les "fameux Tableaux").

Merci

Macro "Très bien" : dans module1. fichier test3GB.xlsm.

Option Base 1

Sub Transferer()

Dim tablo, tabloR(), dteD As Date, dteF As Date, i&, k&

With Sheets("Solde")
    tablo = .Range("A5:E" & .Range("A" & .Rows.Count).End(xlUp).Row)
    dteD = .Range("A2") ' date début
    dteF = .Range("B2") ' date fin
End With

For i = 1 To UBound(tablo)
    If tablo(i, 1) >= dteD And tablo(i, 1) <= dteF Then
        k = k + 1
        ReDim Preserve tabloR(5, k)
        tabloR(1, k) = tablo(i, 1) * 1
        tabloR(2, k) = tablo(i, 2) * 1
        tabloR(3, k) = tablo(i, 3)
        tabloR(4, k) = tablo(i, 4)
        tabloR(5, k) = tablo(i, 5)
    End If
Next i
    'Reception des données dans la feuille"Relevé") à partir de la cellule "A3"
With Sheets("Relevé")
    With .Range("Releve")
        .ClearContents
        If .Rows.Count > 1 Then .Delete
        If k > 0 Then .Resize(UBound(tabloR, 2), UBound(tabloR, 1)) = Application.Transpose(tabloR)
    End With
    Sheets("Relevé").Activate
End With

End Sub

Macro "qui coinçce dans fichier: test4.slsm

Option Base 1
Sub Transferer()

Dim tablo, tabloR(), dteD As Date, dteF As Date, i&, k&

With Sheets("Solde")
    tablo = .Range("A5:H" & .Range("A" & .Rows.Count).End(xlUp).Row)
    dteD = .Range("B2") ' date début
    dteF = .Range("C2") ' date fin
End With

For i = 1 To UBound(tablo)
    If tablo(i, 1) >= dteD And tablo(i, 1) <= dteF Then
        k = k + 1
        ReDim Preserve tabloR(8, k)
        tabloR(1, k) = tablo(i, 1) * 1
        tabloR(2, k) = tablo(i, 2) * 1
        tabloR(3, k) = tablo(i, 3)
        tabloR(4, k) = tablo(i, 4)
        tabloR(5, k) = tablo(i, 5)
        tabloR(6, k) = tablo(i, 6)
        tabloR(7, k) = tablo(i, 7)
        tabloR(8, k) = tablo(i, 8)

    End If
Next i
    'Reception des données dans la feuille"Relevé") à partir de la cellule A4
With Sheets("Relevé")
    With .Range("Releve")
        .ClearContents
        If .Rows.Count > 1 Then .Delete
        If k > 0 Then .Resize(UBound(tabloR, 2), UBound(tabloR, 1)) = Application.Transpose(tabloR)
    End With
    Sheets("Relevé").Activate
End With

End Sub

Bonjour,

Tu utilises des tableaux structurés > il faut coder en conséquence ...

Un essai ...
Dans le tableau de la feuille "Relevé" > après le transfert > si les données sont en chiffres > sélectionne les chiffres > place le format date > les autres fois que la macro sera exécutée > le format des dates suivra ...

Option Base 1

Sub Transferer()
Dim tablo, tabloR(), dteD As Date, dteF As Date, i&, k&

   With Sheets("Solde")
      tablo = Range("Tableau1")   '''.Range("A5:H" & .Range("A" & .Rows.Count).End(xlUp).Row)
      dteD = .Range("B2")   ' date début
      dteF = .Range("C2")   ' date fin
   End With

   For i = 1 To UBound(tablo)
      If tablo(i, 1) >= dteD And tablo(i, 1) <= dteF Then
         k = k + 1
         ReDim Preserve tabloR(8, k)
         tabloR(1, k) = tablo(i, 1) * 1
         tabloR(2, k) = tablo(i, 2) * 1
         tabloR(3, k) = tablo(i, 3)
         tabloR(4, k) = tablo(i, 4)
         tabloR(5, k) = tablo(i, 5)
         tabloR(6, k) = tablo(i, 6)
         tabloR(7, k) = tablo(i, 7)
         tabloR(8, k) = tablo(i, 8)
      End If
   Next i
   'Reception des données dans la feuille"Relevé") à partir de la cellule A4
   '''With Sheets("Relevé")
   With Range("Tableau2")   '''.Range("Releve")
      .ClearContents
      If .Rows.Count > 1 Then .Delete
      If k > 0 Then .Resize(UBound(tabloR, 2), UBound(tabloR, 1)) = Application.Transpose(tabloR)
   End With
   Sheets("Relevé").Activate
   '''End With
End Sub

ric

Bonjour Abdu, Bonjour Ric,

Et vu qu'il commence à y voir pas mal de colonnes, tu peux modifier ainsi le coeur de la boucle for :

for i = lbound(tablo) to ubound(tablo)
    If tablo(i, 1) >= dteD And tablo(i, 1) <= dteF Then
        k = k + 1
        ReDim Preserve tabloR(ubound(tablo, 2), k)
        for j = lbound(tabloR) to ubound(tabloR)
            if j <= 2 then
                tabloR(j, k) = tablo(i, j) * 1
            else
                tabloR(j, k) = tablo(i, j)
            end if
        next j
    End If
next i

Ainsi, le même code vaudra pour 8 colonnes comme pour 12 par exemple...

Cdlt,

Merci ric

ça a marché

Bonne Année 2021

Bonjour 3GB

J'ai ajouté le bout du code dans le coeur de la macro, ça marche .

Merci et bonne Année 2021.

Merci, bonnes fêtes de fin d'année à toi !

A bientôt,