Macro de transfert Feuil1 => Feuil2

[JJ1]

Bonjour à tous,

Grace à votre aide, j'ai terminé mon tableau.
J'ai voulu faire un copier/valeurs en Feuil2 qui a pris......13 minutes (idem pour l'enregistrement).
Serait-il possible par code VBA de me transférer les colonnes A:F en Feuil2 si E=0 et s'il n'y a aucune couleur en ligne dans A😀
Merci de voir mon exemple.
Bon AM à tous.

 

[pierrejean]

Re : Macro de transfert Feuil1 => Feuil2

Bonjour JJ1

Vois si cela te convient (en esperant qu'il n'y a pas trop de cellules colorées)
Tiens nous au courant

 

[JJ1]

Re : Macro de transfert Feuil1 => Feuil2

Bonjour PierreJean,
Je te remercie pour ton code.

Le test de la couleur peut être supprimé dans la macro car inutile maintenant (ça devrait alléger ! )

Je viens de le tester mais il copie aussi les formules (très gourmandes en calcul !) qui sont en E et F (en Feuil1) et donc il est sans cesse en mode recalcul car il calcule aussitôt aussi en Feuil2 avec les formules transférées.
Il faudrait copier en mode collage/valeurs A: F en feuille2 si c'est possible.

Merci encore à toi et bonne soirée

 

[pierrejean]

Re : Macro de transfert Feuil1 => Feuil2

Re

teste la macro suivante

Sub test()
Application.Calculation = xlCalculationManual
ligne = 1
tablo = Sheets("Feuil1").Range("A1:F" & Range("A" & Application.Rows.Count).End(xlUp).Row)
For n = LBound(tablo, 1) To UBound(tablo, 1)
  If tablo(n, 5) <> "" And tablo(n, 5) = 0 Then
    Sheets("feuil1").Range("A" & n & ":F" & n).Copy Destination:=Sheets("Feuil2").Cells(ligne, 1)
   ligne = ligne + 1
  End If
Next
For n = Sheets("Feuil2").Range("A" & Application.Rows.Count).End(xlUp).Row To 1 Step -1
 For m = 1 To 4
   If Sheets("Feuil2").Cells(n, m).Interior.ColorIndex <> -4142 Then Sheets("Feuil2").Rows(n).Delete
 Next m
Next n
Sheets("Feuil2").Select
Sheets("Feuil2").Range("A2:F" & Range("A" & Application.Rows.Count).End(xlUp).Row).Value = Sheets("Feuil2").Range("A2:F" & Range("A" & Application.Rows.Count).End(xlUp).Row).Value
Application.Calculation = xlCalculationAutomatic
End Sub