Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Petite aide concernant une macro vba

titi7500

XLDnaute Junior
Bonjour,

Je suis face à un petit problème. J'ai une macro qui fonctionne très bien mais je me suis rendu compte que dépassé une certaine ligne la macro affiche un message d'erreur: "dépacement de capacité", cela se produit environ à partir de la 30000eme ligne.

Pouvez vous m'aider afin de pouvoir faire en sorte que la marcro continue de tourner même avec + de 50000 lignes, car j'ai un fichier qui va être utilisé durant une année complete et du coup il y a beaucoup de ligne. j'aurais tendance à dire que j'ai besoin d'environ 75000 lignes.

Voici la macro:

Sub Dispatch3()
Dim i As Integer, j As Integer, k As Integer, l As Integer, derligne As Range 'Déclaration des variables
Set derligne = Feuil1.Range("B" & Rows.Count).End(3).Rows
If MsgBox("Voulez vous lancer la macro ?", vbYesNo) = vbNo Then Exit Sub 'Si la réponse est non, on sort de la procédure
For i = 2 To Sheets.Count 'Pour i= 2 jusqu'au nombre de feuilles du classeur
Sheets(i).[A10].CurrentRegion.Clear 'Pour chaque feuille, on supprime tout ce qu'il y a autour de la cellule A9
For l = 2 To derligne.Row
If Cells(l, 2) Like Sheets(i).Name Then 'si la cellule (i,2), donc B2 est égale au nom de la feuille, alors
For j = l To Range("B" & Rows.Count).End(3).Row 'pour j=1 jusqu'à la dernière ligne vide en remontant du bas
If Cells(j, 2) Like Sheets(i).Name Then 'si la cellule (j,2), donc A2 est égale au nom de la feuille, alors
If Sheets(i).Range("A10") = "" Then 'si sur la feuille concernée la cellule A9 est vide alors
Sheets(i).Range("A10") = Cells(j, 1) 'on écrit les données de la 1ère feuille en A9
For k = 1 To 26 'pour k de 1 à 26
Sheets(i).Range("A" & Rows.Count).End(3).Rows(1).Offset(, k) = Cells(j, k + 1) 'on écrit la suite sur les 26 colonnes
Next
Else 'sinon
Sheets(i).Range("A" & Rows.Count).End(3).Rows(2) = Cells(j, 1) 'on écrit à partir de la dernière cellule vide trouvée
For k = 1 To 26
Sheets(i).Range("A" & Rows.Count).End(3).Rows(1).Offset(, k) = Cells(j, k + 1)
Next
End If
End If
Exit For
Next
End If
Next l
Next 'et on recommence pour la ligne suivante
MsgBox "Opération terminée"
End Sub

Merci par avance pour votre aide.

Cordialement.
T.
 

titi7500

XLDnaute Junior
Bonjour pierrejean, merci pour ton aide par contre j'ai un legé soucis, ne maitrisant pas vraiment bien les macros j'ai un peu de mal à comprendre ce qu'il faut changer.

Peux tu s'il te plait mettre en rouge ou vert les modifications à apporter.

Merci par avance.
T
 

titi7500

XLDnaute Junior
Exact, tu as raison dranreb

Pierrejean je vais tester ce que tu as dit.

Par contre j'ai une petite question, y'a t-il un moyen d'acceleré la mise en execution de la macro car plus y'a des lignes, plus ca prend du temps.

Merci par avance.
 
Dernière édition:

Dranreb

XLDnaute Barbatruc
Personnellement j'ai pratiquement proscrit l'utilisation de Cells dans des boucles.
Charger toute la plage dans un tableau et travailler avec les éléments de celui ci.
Edition: Bonjour pierrejean.
 
Dernière édition:

titi7500

XLDnaute Junior
Voici un exemple avec le maximum de données modifiées.

Si vous pouvez m'aider à avoir le meme resultat mais avec moins de temps ca m'arrangerais car comme dit plus y'a de ligne plus ca prend du temps.

Pour info afin de vous aider, la macro va chercher via le numero de compte "Element1" et il va le dispatch dans son onglet respectif.

A chaque fois que je vais relancer la macro il va copier coller depuis le début afin qu'il y ai pas de doublon.

Merci par avance.
T
 

Pièces jointes

  • TEST MACRO.xlsm
    5.3 MB · Affichages: 28

Discussions similaires

Réponses
2
Affichages
329
Réponses
4
Affichages
453
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…