Microsoft 365 Copie de cellules non adjacentes en Vba

mapomme à dit:

Re,

Je pensais que tu avais écrit 40 000 au lieu de 400 000 . Je vais voir demain samedi ce qu'il en est avec 40 000 lignes.

Juste pour le fun (ce n'est pas la méthode la plus rapide), une procédure qui n'utilise que des "manipulations Excel".

VB:

Sub ViaExcel()
Dim max&, deb
   deb = Timer: Application.ScreenUpdating = False
   With Sheets("Feuil1")
      Sheets("Feuil2").Columns("a:e").ClearContents
      max = .Range("a1").CurrentRegion.Rows.Count
      .Range("a:d").Resize(max).Copy Sheets("Feuil2").Range("a1")
   End With
   With Sheets("Feuil2")
      .Columns("e:e").Resize(max).Formula = "=IF(ROUND(RC[-2],2)<>ROUND(RC[-1],2),0,#N/A)"
      .Columns("e:e").Resize(max).Value = .Columns("e:e").Resize(max).Value
      [e1] = 0
      .Columns("a:e").Resize(max).Sort key1:=.Range("e1"), order1:=xlAscending, Header:=xlYes
      On Error Resume Next
      .Columns("e:e").Resize(max).SpecialCells(xlCellTypeConstants, xlErrors).EntireRow.Resize(, 5).Delete
      .Columns("e:e").Resize(max).ClearContents
   End With
   MsgBox "C'est fini en : " & Format(Timer - deb, "#0.00\ sec.")
End Sub

Cliquez pour agrandir...

RyuAutodidacte à dit:

Mea culpa , je viens de me rendre compte que c'est bien 400 000, mes yeux mon joués des tours, voilà ce qui arrive qd on travail trop; c'est vrai que le chiffre de la message box m'a pas aidé quand j'ai ouvert le fichier :

Cliquez pour agrandir...