Utilisation des tableaux pour supprimer des lignes VBA

Bonjour à tous,

J'ai besoin de transférer des lignes d'un fichier excel "Test1.xlsx" vers un autre fichier excel "Test2.xlsx" et de supprimer les lignes.

J'ai un programme qui fait cela mais le nombre de lignes est très important et le programme prend donc beaucoup de temps.

Je souhaite donc trouver une autre méthode. J'ai vu sur ce forum que l'on pouvait passer par des tableaux.

J'ai trouvé ce programme :

Sub Transfert()
Dim tablo1, i&, tablo2(), n&
tablo1 = Sheets("Feuil1").Range("A1:B" & Sheets("Feuil1").[A65536].End(xlUp).Row)
For i = 1 To UBound(tablo1)
  If tablo1(i, 2) Like "BCD" Then
    ReDim Preserve tablo2(1, n)
    tablo2(0, n) = tablo1(i, 1)
    tablo2(1, n) = tablo1(i, 2)
    n = n + 1
  End If
Next
If n Then
  Sheets("Feuil2").[A2:B65536].ClearContents
  Sheets("Feuil2").[A2].Resize(n, 2) = Application.Transpose(tablo2)
End If
End Sub

Cependant, je n'arrive pas à le transposer pour mes besoins.

Ceux-ci sont :

• Les données commencent à la ligne 5
• Transférer toutes les lignes (colonne A à AH avec des valeurs) qui, dans la colonne Z, valent "fermés" ou "fermés1" ou "fermés2".
• Supprimer ces lignes du fichier "Test1" pour remonter le reste.

J'espère avoir été clair, n'hésitez pas à me poser des questions.

Merci d'avance,

Simon

Bonjour,

comme nous n'avons pas de fichier pour travailler, c'est difficile de te répondre correctement, et impossible de tester, aussi vais-je te donner un code incomplet qui peut potentiellement avec une ou deux erreurs, mais ça te donnera une idée du code à faire:

Sub test()
Dim tabDep, tabRestant, tabTransf
Dim ligFin, nbLigRestant, nbLigTransf, ligRestant, ligTransf

'initialisation
ligFin = Range("a" & Rows.Count).End(xlUp).Row
tabDep = Range("a5", "ah" & ligFin)
nbLigRestant = 0
nbLigTransf = 0
ligRestant = 1
ligTransf = 1

'pour dimensionner les tableaux
For i = LBound(tabDep, 1) To UBound(tabDep, 1)
    If tabDep(i, 26) Like "fermés*" Then
        nbLigTransf = nbLigTransf + 1
    Else
        nbLigRestant = nbLigRestant + 1
    End If
Next i

'redimensionnement
ReDim tabRestant(1 To nbLigRestant, 1 To UBound(tabDep, 2))
ReDim tabTransf(1 To nbLigTransf, 1 To UBound(tabDep, 2))

'remplissage des tableaux
For i = LBound(tabDep, 1) To UBound(tabDep, 1)
    If tabDep(i, 26) Like "fermés*" Then
        For j = 1 To UBound(tabDep, 2)
            tabTransf(ligTransf, j) = tabDep(i, j)
        Next j
        ligTransf = ligTransf + 1
    Else
        For j = 1 To UBound(tabDep, 2)
            tabRestant(ligRestant, j) = tabDep(i, j)
        Next j
        ligRestant = ligRestant + 1
    End If
Next i
End Sub

Le code se charge d'enregistrer ta plage à traiter dans un tableau VBA, puis crée deux autres tableaux VBA qui seront ton tableau test1 qui restera après le transfert, et le tableau test2 qui contiendra les données transférées, il te restera juste à les utiliser dans ton code.

Bonjour Ausecour,

Merci beaucoup pour ton efficacité et ta rapidité.

Je te joins les deux fichiers que j'ai limité à 50 lignes.

J'ai remarqué que dans mon fichier de base il y avait des "FERMES" en majuscule qu'il faut également transférer, j'en ai donc mis.

Autre point, est-ce possible de ne transférer les lignes qui sont inférieures à Mai (colonne B) ?

Merci énormément pour ton aide et ton temps,

Simon

Re,

c'est possible de prendre aussi en compte FERMES et la date, par contre la date risque de changer je pense....

Une autre solution sans passer par VBA, qui serait simple à faire, c'est d'appliquer un filtre sur tes données (par filtre avancé ou filtre simple), tu affiches les données à transférer, tu copies colles, puis tu supprimes les lignes. Si tu ne fais cette opération que de façon hebdomadaire ou mensuelle, je ne pense pas que ça soit nécessaire de passer par du VBA au final en revanche si tu dois faire ça plusieurs fois par jour et que ça te prendrait pas mal de temps, une solution automatisée pourrait être une idée pour ne pas avoir à filtrer, copier, coller, supprimer à chaque fois.

Bonjour à tous

On peut automatiser un filtre avancé : un code pour extraire dans un nouvel onglet et le déplacer dans un nouveau classeur prend généralement peu de temps

Bonjour à vous deux.

En effet il faudrait le faire tous les jours et il y a beaucoup de lignes à supprimer ce qui prend beaucoup de temps.

J'aimerais donc l'automatiser et qui plus est avec des tableaux pour gagner un maximum de temps.

Bien à vous,

Simon

Re!

Je te propose cette solution:

la macro te demande de saisir une date, comme le dis la boite de saisie, seules les dates antérieures à celle que tu vas saisir seront traitées, si tu ne veux traiter que les dates antérieures à Mai, il te suffira de saisir 1/5/19 dans la boite de saisie, un message d'information t'indiquera que la macro a bien été exécutée