Optimiser Un Code de transfert de données d'une Feuille a une Autre

[salhi_haithem]

Bonjour a tous
J'aimerai Optimiser Ce Code qui me permet de transférer de données d'une Feuille (base) a une autre
ce code fonctionne parfaitement sans aucun problème sauf qu'il prend beaucoup de temps c'est-a-dire pour transférer 70 lignes de base vers un fichier il prend environ 60 Seconde
je cherche a optimiser
merci d'avance pour votre Aide

Function TransfertVersJournal()

Dim Destination As Worksheet
Dim Source As Worksheet

Set Source = Worksheets("Base")
Set Destination = Worksheets("Journal")

i = 2      'commence à regarder la ligne 2 feuille Source
j = 11    'pour copier dans la feuille Destination a partir de la ligne 11


Source.Select 'sélectionne la feuille 1

Do While Cells(i, 1) <> "" 'la macro s'exécutera tant que dans la cellule de la ligne i et colonne 1 il y aura une valeur
If Cells(i, 1) <> "" Then 'si la cellule de la ligne i colonne 1 différente de null
    
Destination.Cells(j, 1) = Source.Cells(i, 1)   'N° Action
Destination.Cells(j, 2) = Source.Cells(i, 16) 'Date Enclenchement
Destination.Cells(j, 3) = Source.Cells(i, 19) 'Délais 1
Destination.Cells(j, 4) = Source.Cells(i, 28) 'Délais 2
Destination.Cells(j, 5) = Source.Cells(i, 29) 'Délais 3
Destination.Cells(j, 6) = Source.Cells(i, 30) 'Délais 4
Destination.Cells(j, 7) = Source.Cells(i, 31) 'Délais 5
Destination.Cells(j, 8) = Source.Cells(i, 32) 'T.Estimation
Destination.Cells(j, 9) = Source.Cells(i, 9) 'Action a Faire
Destination.Cells(j, 13) = Source.Cells(i, 26) 'Suivi
Destination.Cells(j, 17) = Source.Cells(i, 25) 'Priorité
Destination.Cells(j, 18) = Source.Cells(i, 27) 'Etat
Destination.Cells(j, 19) = Source.Cells(i, 24) 'T.Total
Destination.Cells(j, 20) = Source.Cells(i, 34) 'Compteur
Destination.Cells(j, 21) = Source.Cells(i, 10) 'Responsable
Destination.Cells(j, 22) = Source.Cells(i, 3) 'Service

j = j + 1
End If 'fin du if
i = i + 1
Loop 'retourne au do while

Destination.Select


End Function

 

[Paf]

Re : Optimiser Un Code de transfert de données d'une Feuille a une Autre

Bonjour,

une solution possible:

Sub TransfertVersJournal()
Dim Destination As Worksheet, Source As Worksheet
Dim DerL As Integer, Vide As Integer, TabFin
Set Source = Worksheets("Base")
Set Destination = Worksheets("Journal")

i = 2      'commence à regarder la ligne 2 feuille Source
j = 11    'pour copier dans la feuille Destination a partir de la ligne 11

With Source
  DerL = .Range("A" & .Rows.Count).End(xlUp).Row ' 
  ReDim TabFin(DerL - i)
  With .Range("A" & i & ":AI" & DerL) ' Plage de données
    TabFin = Application.Index(.Value, Evaluate("row(1:" & DerL & ")"), Array(1, 16, 19, 28, 29, 30, 31, 32, 9, Vide, Vide, Vide, 26, Vide, Vide, Vide, 25, 27, 24, 34, 10, 3))
  End With
End With
Destination.Range("A" & j).Resize(UBound(TabFin, 1), UBound(TabFin, 2)) = TabFin

End Sub

non testé faute de classeur d'essai

A+

 

[job75]

Re : Optimiser Un Code de transfert de données d'une Feuille a une Autre

Bonjour salhi_haithem, salut Paf,

pour transférer 70 lignes de base vers un fichier il prend environ 60 Seconde

Ce n'est pas normal, transférer les valeurs de 70 x 16 = 1120 cellules doit prendre 2/10ème de seconde, c'est pinuts.

Il y a sans doute dans le classeur des formules volatiles qui se recalculent.

Donc mettez au début de votre code Application.Calculation = xlCalculationManual

Et à la fin Application.Calculation = xlCalculationAutomatic

Nota : votre test If...Then/End If ne sert à rien...

A+

 

[job75]

Re : Optimiser Un Code de transfert de données d'une Feuille a une Autre

Re,

Pas fait attention, vous avez écrit Function TransfertVersJournal()

C'est bien sûr Sub TransfertVersJournal() qu'il faut écrire

A+

 

[job75]

Re : Optimiser Un Code de transfert de données d'une Feuille a une Autre

Re,

Avec des tableaux VBA les données sont transférées d'un seul coup :

Sub TransfertVersJournal()
Dim source, destination, i&
With Sheets("Base").Range("A2", Sheets("Base").Cells([A2].End(xlDown).Row, 34))
  source = IIf(.Cells(2, 1) = "", .Cells.Resize(1), .Cells)
End With
With Sheets("Journal").[A11].Resize(UBound(source), 22)
  destination = .Formula 'au cas où il y aurait des formules
  For i = 1 To UBound(source)
    destination(i, 1) = source(i, 1)   'N° Action
    destination(i, 2) = source(i, 16) 'Date Enclenchement
    destination(i, 3) = source(i, 19) 'Délais 1
    destination(i, 4) = source(i, 28) 'Délais 2
    destination(i, 5) = source(i, 29) 'Délais 3
    destination(i, 6) = source(i, 30) 'Délais 4
    destination(i, 7) = source(i, 31) 'Délais 5
    destination(i, 8) = source(i, 32) 'T.Estimation
    destination(i, 9) = source(i, 9) 'Action a Faire
    destination(i, 13) = source(i, 26) 'Suivi
    destination(i, 17) = source(i, 25) 'Priorité
    destination(i, 18) = source(i, 27) 'Etat
    destination(i, 19) = source(i, 24) 'T.Total
    destination(i, 20) = source(i, 34) 'Compteur
    destination(i, 21) = source(i, 10) 'Responsable
    destination(i, 22) = source(i, 3) 'Service
  Next
  .Formula = destination 'restitution
End With
End Sub

Donc pas de problème avec le recalcul des formules.

De plus s'il y avait beaucoup de lignes c'est beaucoup plus rapide.

Bonne soirée.

 

[salhi_haithem]

Re : Optimiser Un Code de transfert de données d'une Feuille a une Autre

Merci les amis Pour Vos réponses c'est hyper rapide juste pour le code de Paf qui fonctionne bien il m'apporte une ligne vide juste j'ai ajouté -1 après DerL

TabFin = Application.Index(.Value, Evaluate("row(1:" & [B]DerL -1[/B] & ")"), Array(1, 16, 19, 28, 29, 30, 31, 32, 9, Vide, Vide, Vide, 26, Vide, Vide, Vide, 25, 27, 24, 34, 10, 3))

ça fonctionne maintenant très bien
pour le code de job75

lors du premier teste il a fonctionné bien après ca le code transfert que les 9 premières lignes seulement de la base vers le journal

on tout-cas merci pour vos codes

 

[salhi_haithem]

Re : Optimiser Un Code de transfert de données d'une Feuille a une Autre

Re,

Pas fait attention, vous avez écrit Function TransfertVersJournal()

C'est bien sûr Sub TransfertVersJournal() qu'il faut écrire

A+

quel est la différence entre sub function